diff --git a/README.lilac b/README.lilac new file mode 100644 index 0000000000..6a4414e6ae --- /dev/null +++ b/README.lilac @@ -0,0 +1,110 @@ +======================================================================== +I. Building a CTSM / LILAC library for inclusion in an atmosphere model +======================================================================== + +1) check out the code (ctsm and lilac are now bundled together) and built as one library + + > git clone https://github.com/ESCOMP/ctsm.git + > git checkout lilac_cap + > ./manage_externals/checkout_externals -v + +2) set the following environment variables + SRCROOT is where ctsm is checked out + + > export SRCROOT=`pwd` + > export CASEDIR=/glade/scratch/$USER/test_lilac + +3) build the ctsm/lilac library using a CIME case + + > cd $SRCROOT/cime/scripts + > ./create_newcase --case $CASEDIR --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver nuopc + > cd $CASEDIR + > ./xmlchange LILAC_MODE=on + > ./xmlchange DEBUG=TRUE + > ./case.setup + > ./case.build --sharedlib-only + +======================================================================== +II. Building and running the test atmosphere driver +======================================================================== + +After following the above instructions for building a CTSM / LILAC +library (I), do the following: + +1) To build the atm_driver executable on cheyenne (***CTSM_MKFILE IS CRITICAL for the operation of the atm_driver makefile) + + > export CTSM_MKFILE=$CASEDIR/bld/ctsm.mk + > cd $SRCROOT/lilac/atm_driver + > $SRCROOT/cime/tools/configure --comp-interface nuopc --macros-format Makefile --clean + > make clean + > source ./.env_mach_specific.sh + > export DEBUG=TRUE + > make COMPILER=intel atm_driver + +2) to generate the input namelists + + - to customize the generated namelist - edit the file ctsm.cfg (in this directory) + - to create the ctsm namelist FROM THIS DIRECTORY: + + > $SRCROOT/lilac_config/buildnml + + - this will now create the files lnd_in and clm.input_data_list in this directory + THIS ONLY NEEDS TO BE DONE ONCE + to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory + +3) run the atm_driver on cheyenne + + > qsub cheyenne.sub + +4) compare with latest baselines + + use something like this to compare the last clm and last cpl hist files: + + > basedir=/glade/p/cgd/tss/ctsm_baselines/lilac_20191202 + > cprnc test_lilac.clm2.h0.2000-01-03-00000.nc $basedir/test_lilac.clm2.h0.2000-01-03-00000.nc | tail -30 + > cprnc test_lilac.lilac.hi.2000-01-02-81000.nc $basedir/test_lilac.lilac.hi.2000-01-02-81000.nc | tail -30 + > cprnc -m test_lilac.atm.h0.0001-01.nc $basedir/test_lilac.atm.h0.0001-01.nc | tail -30 + +5) if there are differences, and those are intentional, then create new + baselines + + copy all *.nc files, plus ctsm.cfg, lilac_in and lnd_in to the + baseline directory + +======================================================================== +III. Linking the CTSM / LILAC library into another atmosphere model +======================================================================== + +After following the above instructions for building a CTSM / LILAC +library (I), you should do the following, assuming that the atmosphere +model is built using a makefile: + +1) Set some environment variable (e.g., CTSM_MKFILE) to point to the + ctsm.mk file generated in CTSM's bld directory. + +2) Modify the atmosphere model's makefile to include the file given by + the environment variable $CTSM_MAKEFILE. + +3) In the compilation line for the atmosphere model, add + $(CTSM_INCLUDES) + +4) In the link line for the atmosphere model, add $(CTSM_LIBS) + +======================================================================== +IV. Running CTSM / LILAC from another atmosphere model +======================================================================== + +After (III), the following steps are needed to stage the inputs needed +for running the atmosphere model + +1) Generate the input namelists following the instructions given in part + (II). + +2) Copy the following files from $SRCROOT/lilac/atm_driver into the + directory from which the atmosphere model will be run: + + - lilac_in + - lnd_in + - lnd_modelio.nml + +3) Run the atmosphere model diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 4ee6a65eda..db6fc6cb55 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -35,7 +35,7 @@ use File::Basename qw(dirname); use English; use Getopt::Long; use IO::File; -use File::Glob ':glob'; +use File::Glob ':bsd_glob'; #------------------------------------------------------------------------------- # @@ -189,7 +189,6 @@ OPTIONS 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. -lnd_tuning_mode "value" Use the parameters tuned for the given configuration (CLM version and atmospheric forcing) -mask "landmask" Type of land-mask (default, navy, gx3v5, gx1v5 etc.) "-mask list" to list valid land masks. @@ -255,7 +254,6 @@ sub process_commandline { help => 0, glc_nec => "default", light_res => "default", - l_ncpl => undef, lnd_tuning_mode => "default", lnd_frac => undef, dir => "$cwd", @@ -307,7 +305,6 @@ sub process_commandline { "infile=s" => \$opts{'infile'}, "lnd_frac=s" => \$opts{'lnd_frac'}, "lnd_tuning_mode=s" => \$opts{'lnd_tuning_mode'}, - "l_ncpl=i" => \$opts{'l_ncpl'}, "inputdata=s" => \$opts{'inputdata'}, "mask=s" => \$opts{'mask'}, "namelist=s" => \$opts{'namelist'}, @@ -477,7 +474,7 @@ sub read_envxml_case_files { 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" ); + my @files = bsd_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" ); @@ -1394,9 +1391,6 @@ sub process_namelist_commandline_clm_usr_name { $nvars++; } } - if ( $nvars == 0 ) { - $log->message("setting clm_usr_name -- but did NOT find any user datasets: $opts->{'clm_usr_name'}", $opts); - } # Go through all variables and expand any XML env settings in them expand_xml_variables_in_namelist( $nl_usrfile, $envxml_ref ); # Merge input values into namelist. Previously specified values have higher precedence @@ -1438,7 +1432,7 @@ sub process_namelist_commandline_use_case { 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'"); + $log->verbose_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); } @@ -1486,7 +1480,6 @@ sub process_namelist_inline_logic { setup_logic_co2_type($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_irrigate($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_snow($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_glacier($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref); @@ -1862,28 +1855,6 @@ sub setup_logic_start_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) = @_; @@ -4203,7 +4174,7 @@ sub validate_options { # 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"); + my @files = bsd_glob("$opts->{'use_case_dir'}/*.xml"); foreach my $file (@files) { $file =~ m{.*/(.*)\.xml}; &check_use_case_name( $1 ); @@ -4217,7 +4188,7 @@ sub validate_options { } else { print "Use cases are:...\n\n"; my @ucases; - foreach my $file( sort( glob($opts->{'use_case_dir'}."/*.xml") ) ) { + foreach my $file( sort( bsd_glob($opts->{'use_case_dir'}."/*.xml") ) ) { my $use_case; if ( $file =~ /\/([^\/]+)\.xml$/ ) { &check_use_case_name( $1 ); diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 86439f2452..f5504aafc7 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -19,9 +19,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 2000 - -1800 - 379.0 379.0 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 5d142e4626..e7bb4b3f60 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -619,11 +619,6 @@ The maximum value to use for zeta under stable conditions baseline proportion of nitrogen allocated for electron transport (J) - -Time step (seconds) - - Toggle to turn on the FATES model diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index c833f44d3d..b8b7157703 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 842; +my $ntests = 834; if ( defined($opts{'compare'}) ) { - $ntests += 510; + $ntests += 507; } plan( tests=>$ntests ); @@ -287,15 +287,15 @@ sub make_config_cache { &make_config_cache($phys); print "\n===============================================================================\n"; -print "Test configuration, structure, irrigate, verbose, clm_demand, ssp_rcp, test, sim_year, use_case, l_ncpl\n"; +print "Test configuration, structure, irrigate, verbose, clm_demand, ssp_rcp, test, sim_year, use_case\n"; print "=================================================================================\n"; -# configuration, structure, irrigate, verbose, clm_demand, ssp_rcp, test, sim_year, use_case, l_ncpl +# configuration, structure, irrigate, verbose, clm_demand, ssp_rcp, test, sim_year, use_case my $startfile = "clmrun.clm2.r.1964-05-27-00000.nc"; foreach my $options ( "-configuration nwp", "-structure fast", "-namelist '&a irrigate=.true./'", "-verbose", "-ssp_rcp SSP1-2.6", "-test", "-sim_year 1850", - "-use_case 1850_control", "-l_ncpl 1", + "-use_case 1850_control", "-clm_start_type startup", "-namelist '&a irrigate=.false./' -crop -bgc bgc", "-envxml_dir . -infile myuser_nl_clm", "-ignore_ic_date -clm_start_type branch -namelist '&a nrevsn=\"thing.nc\"/' -bgc bgc -crop", @@ -309,10 +309,7 @@ sub make_config_cache { $cfiles->checkfilesexist( "$options", $mode ); $cfiles->shownmldiff( "default", $mode ); my $finidat = `grep finidat lnd_in`; - if ( $options eq "-l_ncpl 1" ) { - my $dtime = `grep dtime lnd_in`; - like( $dtime, "/ 86400\$/", "$options" ); - } elsif ( $options =~ /myuser_nl_clm/ ) { + if ( $options =~ /myuser_nl_clm/ ) { my $fsurdat = `grep fsurdat lnd_in`; like( $fsurdat, "/MYDINLOCROOT/lnd/clm2/PTCLMmydatafiles/1x1pt_US-UMB/surfdata_1x1pt_US-UMB_simyr2000_clm4_5_c131122.nc/", "$options" ); } @@ -391,21 +388,6 @@ sub make_config_cache { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, - "l_ncpl is zero" =>{ options=>"-l_ncpl 0 -envxml_dir .", - namelst=>"", - GLC_TWO_WAY_COUPLING=>"FALSE", - phys=>"clm5_0", - }, - "l_ncpl not integer" =>{ options=>"-l_ncpl 1.0 -envxml_dir .", - namelst=>"", - GLC_TWO_WAY_COUPLING=>"FALSE", - phys=>"clm5_0", - }, - "both l_ncpl and dtime" =>{ options=>"-l_ncpl 24 -envxml_dir .", - namelst=>"dtime=1800", - GLC_TWO_WAY_COUPLING=>"FALSE", - phys=>"clm5_0", - }, "use_crop without -crop" =>{ options=>" -envxml_dir .", namelst=>"use_crop=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py new file mode 100644 index 0000000000..ed4624ff57 --- /dev/null +++ b/cime_config/SystemTests/lilacsmoke.py @@ -0,0 +1,374 @@ +""" +Implementation of the CIME LILACSMOKE (LILAC smoke) test. + +This is a CTSM-specific test. It tests the building and running of CTSM via LILAC. Compset +is ignored, but grid is important. Also, it's important that this test use the nuopc +driver, both for the sake of the build and for extracting some runtime settings. This test +should also use the lilac testmod (or a testmod that derives from it) in order to +establish the user_nl_ctsm file correctly. + +Important directories under CASEROOT are: +- lilac_build: this contains the build and the runtime inputs for the lilac run +- lilac_atm_driver: this contains the build of the test driver as well as the run + directory in which the test is actually run + +Note that namelists for this test are generated in the build phase; they are NOT +regenerated when the test is submitted / run. This means that, if you have made any +changes that will impact namelists, you will need to rebuild this test. +""" + +import glob +import os +import shutil + +from CIME.SystemTests.system_tests_common import SystemTestsCommon +from CIME.utils import run_cmd, run_cmd_no_fail, symlink_force, new_lid, safe_copy, append_testlog +from CIME.build import post_build +from CIME.test_status import NAMELIST_PHASE, GENERATE_PHASE, BASELINE_PHASE, TEST_PASS_STATUS, TEST_FAIL_STATUS +from CIME.XML.standard_module_setup import * + +logger = logging.getLogger(__name__) + +_LILAC_RUNTIME_FILES = ['lnd_in', 'lnd_modelio.nml', 'lilac_in'] + +class LILACSMOKE(SystemTestsCommon): + + def __init__(self, case): + SystemTestsCommon.__init__(self, case) + + def build_phase(self, sharedlib_only=False, model_only=False): + if not sharedlib_only: + caseroot = self._case.get_value('CASEROOT') + lndroot = self._case.get_value('COMP_ROOT_DIR_LND') + exeroot = self._case.get_value('EXEROOT') + build_dir = os.path.join(caseroot, 'lilac_build') + script_path = os.path.abspath(os.path.join(lndroot, 'lilac', 'build_ctsm')) + + # We only run the initial build command if the build_dir doesn't exist + # yet. This is to support rebuilding the test case. (The first time through, + # the build_dir won't exist yet; subsequent times, it will already exist, so + # we skip to the rebuild command.) + if not os.path.isdir(build_dir): + machine = self._case.get_value('MACH') + compiler = self._case.get_value('COMPILER') + debug = self._case.get_value('DEBUG') + # It would be possible to do this testing via the python interface rather + # than through a separate subprocess. However, we do it through a + # subprocess in order to test the full build_ctsm script, including + # command-line parsing. + cmd = '{script_path} {build_dir} --machine {machine} --compiler {compiler}'.format( + script_path=script_path, + build_dir=build_dir, + machine=machine, + compiler=compiler) + # It isn't straightforward to determine if pnetcdf is available on a + # machine. To keep things simple, always run without pnetcdf. + cmd += ' --no-pnetcdf' + if debug: + cmd += ' --build-debug' + self._run_build_cmd(cmd, exeroot, 'build_ctsm.bldlog') + + # We call the build script with --rebuild even for an initial build. This is + # so we make sure to test the code path for --rebuild. (This is also needed if + # the user rebuilds the test case, in which case this will be the only command + # run, since the build_dir will already exist.) + cmd = '{script_path} {build_dir} --rebuild'.format( + script_path=script_path, + build_dir=build_dir) + self._run_build_cmd(cmd, exeroot, 'rebuild_ctsm.bldlog') + + self._build_atm_driver() + + self._create_link_to_atm_driver() + + self._create_runtime_inputs() + + self._setup_atm_driver_rundir() + + self._cmpgen_namelists() + + # Setting logs=[] implies that we don't bother gzipping any of the build log + # files; that seems fine for these purposes (and it keeps the above code + # simpler). + post_build(self._case, logs=[], build_complete=True) + + def _build_atm_driver(self): + caseroot = self._case.get_value('CASEROOT') + lndroot = self._case.get_value('COMP_ROOT_DIR_LND') + blddir = os.path.join(caseroot, 'lilac_atm_driver', 'bld') + + if not os.path.exists(blddir): + os.makedirs(blddir) + symlink_force(os.path.join(lndroot, 'lilac', 'atm_driver', 'Makefile'), + os.path.join(blddir, 'Makefile')) + symlink_force(os.path.join(lndroot, 'lilac', 'atm_driver', 'atm_driver.F90'), + os.path.join(blddir, 'atm_driver.F90')) + symlink_force(os.path.join(caseroot, 'Macros.make'), + os.path.join(blddir, 'Macros.make')) + + makevars = 'COMPILER={compiler} DEBUG={debug} CTSM_MKFILE={ctsm_mkfile}'.format( + compiler=self._case.get_value('COMPILER'), + debug=str(self._case.get_value('DEBUG')).upper(), + ctsm_mkfile=os.path.join(caseroot, 'lilac_build', 'ctsm.mk')) + makecmd = 'make {makevars} atm_driver'.format(makevars=makevars) + self._run_build_cmd(makecmd, blddir, 'atm_driver.bldlog') + + def _create_link_to_atm_driver(self): + caseroot = self._case.get_value('CASEROOT') + run_exe = (self._case.get_value('run_exe')).strip() + + # Make a symlink to the atm_driver executable so that the case's run command finds + # it in the expected location + symlink_force(os.path.join(caseroot, 'lilac_atm_driver', 'bld', 'atm_driver.exe'), + run_exe) + + def _create_runtime_inputs(self): + caseroot = self._case.get_value('CASEROOT') + runtime_inputs = self._runtime_inputs_dir() + lnd_domain_file = os.path.join(self._case.get_value('LND_DOMAIN_PATH'), + self._case.get_value('LND_DOMAIN_FILE')) + + # Cheat a bit here: Get the fsurdat file from the already-generated lnd_in file in + # the host test case - i.e., from the standard cime-based preview_namelists. But + # this isn't really a morally-objectionable cheat, because in the real workflow, + # we expect the user to identify fsurdat manually; in this testing situation, we + # need to come up with some way to replace this manual identification, so cheating + # feels acceptable. + self._case.create_namelists(component='lnd') + fsurdat = self._extract_var_from_namelist( + nl_filename=os.path.join(caseroot, 'CaseDocs', 'lnd_in'), + varname='fsurdat') + + self._fill_in_variables_in_file(filepath=os.path.join(runtime_inputs, 'ctsm.cfg'), + replacements={'lnd_domain_file':lnd_domain_file, + 'fsurdat':fsurdat}) + + # The user_nl_ctsm in the case directory is set up based on the standard testmods + # mechanism. We use that one in place of the standard user_nl_ctsm, since the one + # in the case directory may contain test-specific modifications. + shutil.copyfile(src=os.path.join(caseroot, 'user_nl_ctsm'), + dst=os.path.join(runtime_inputs, 'user_nl_ctsm')) + + script_to_run = os.path.join(runtime_inputs, 'make_runtime_inputs') + self._run_build_cmd('{} --rundir {}'.format(script_to_run, runtime_inputs), + runtime_inputs, + 'make_runtime_inputs.log') + + # In lilac_in, we intentionally use the land mesh file for both atm_mesh_filename + # and lnd_mesh_filename + lnd_mesh = self._case.get_value('LND_DOMAIN_MESH') + casename = self._case.get_value('CASE') + self._fill_in_variables_in_file(filepath=os.path.join(runtime_inputs, 'lilac_in'), + replacements={'caseid':casename, + 'atm_mesh_filename':lnd_mesh, + 'lnd_mesh_filename':lnd_mesh, + 'lilac_histfreq_option':'ndays'}, + placeholders={'caseid':'ctsm_lilac', + 'lilac_histfreq_option':'never'}) + + # We run download_input_data partly because it may be needed and partly to test + # this script. + script_to_run = os.path.join(runtime_inputs, 'download_input_data') + self._run_build_cmd('{} --rundir {}'.format(script_to_run, runtime_inputs), + runtime_inputs, + 'download_input_data.log') + + def _setup_atm_driver_rundir(self): + """Set up the directory from which we will actually do the run""" + lndroot = self._case.get_value('COMP_ROOT_DIR_LND') + rundir = self._atm_driver_rundir() + + if not os.path.exists(rundir): + os.makedirs(rundir) + shutil.copyfile(src=os.path.join(lndroot, 'lilac', 'atm_driver', 'atm_driver_in'), + dst=os.path.join(rundir, 'atm_driver_in')) + + # As elsewhere: assume the land variables also apply to the atmosphere + lnd_mesh = self._case.get_value('LND_DOMAIN_MESH') + lnd_nx = self._case.get_value('LND_NX') + lnd_ny = self._case.get_value('LND_NY') + expect(self._case.get_value('STOP_OPTION') == 'ndays', + 'LILAC testing currently assumes STOP_OPTION of ndays, not {}'.format( + self._case.get_value('STOP_OPTION'))) + stop_n = self._case.get_value('STOP_N') + casename = self._case.get_value('CASE') + self._fill_in_variables_in_file(filepath=os.path.join(rundir, 'atm_driver_in'), + replacements={'caseid':casename, + 'atm_mesh_file':lnd_mesh, + 'atm_global_nx':str(lnd_nx), + 'atm_global_ny':str(lnd_ny), + 'atm_stop_day':str(stop_n+1), + 'atm_ndays_all_segs':str(stop_n)}) + + for file_to_link in _LILAC_RUNTIME_FILES: + symlink_force(os.path.join(self._runtime_inputs_dir(), file_to_link), + os.path.join(rundir, file_to_link)) + + def _cmpgen_namelists(self): + """Redoes the namelist comparison & generation with appropriate namelists + + The standard namelist comparison & generation is done with the CaseDocs directory + from the test case. That isn't appropriate here, because those namelists aren't + actually used in this test. Instead, we want to compare & generate the namelists + used by the atm_driver-lilac-ctsm execution. Here, we do some file copies and then + re-call the namelist comparison & generation script in order to accomplish + this. This will overwrite the namelists generated earlier in the test, and will + also replace the results of the NLCOMP phase. + + Note that we expect a failure in the NLCOMP phase that is run earlier in the test, + because that one will have compared the test's standard CaseDocs with the files + generated from here - and those two sets of namelists can be quite different. + """ + caseroot = self._case.get_value('CASEROOT') + casedocs = os.path.join(caseroot, 'CaseDocs') + if os.path.exists(casedocs): + shutil.rmtree(casedocs) + os.makedirs(casedocs) + + # case_cmpgen_namelists uses the existence of drv_in to decide whether namelists + # need to be regenerated. We do NOT want it to regenerate namelists, so we give it + # the file it wants. + with open(os.path.join(casedocs, 'drv_in'), 'a') as drv_in: + pass + + for onefile in _LILAC_RUNTIME_FILES + ['atm_driver_in']: + safe_copy(os.path.join(self._atm_driver_rundir(), onefile), + os.path.join(casedocs, onefile)) + + success = self._case.case_cmpgen_namelists() + # The setting of the NLCOMP phase status in case_cmpgen_namelists doesn't work + # here (probably because the test object has a saved version of the test status + # and so, when it goes to write the status of the build phase, it ends up + # overwriting whatever was set by case_cmpgen_namelists). So we need to set it + # here. + with self._test_status: + self._test_status.set_status(NAMELIST_PHASE, TEST_PASS_STATUS if success else TEST_FAIL_STATUS, + comments="(used lilac namelists)") + + def _extract_var_from_namelist(self, nl_filename, varname): + """Tries to find a variable named varname in the given file; returns its value + + If not found, aborts + """ + with open(nl_filename) as nl_file: + for line in nl_file: + match = re.search(r'^ *{} *= *[\'"]([^\'"]+)'.format(varname), line) + if match: + return match.group(1) + expect(False, '{} not found in {}'.format(varname, nl_filename)) + + def _fill_in_variables_in_file(self, filepath, replacements, placeholders=None): + """For the given file, make the given replacements + + replacements should be a dictionary mapping variable names to their values + + If placeholders is given, it should be a dictionary mapping some subset of + variable names to their placeholders. Anything not given here uses a placeholder + of 'FILL_THIS_IN'. + """ + if placeholders is None: + placeholders = {} + + orig_filepath = '{}.orig'.format(filepath) + if not os.path.exists(orig_filepath): + shutil.copyfile(src=filepath, + dst=orig_filepath) + os.remove(filepath) + + counts = dict.fromkeys(replacements, 0) + with open(orig_filepath) as orig_file: + with open(filepath, 'w') as new_file: + for orig_line in orig_file: + line = orig_line + for varname in replacements: + if varname in placeholders: + this_placeholder = placeholders[varname] + else: + this_placeholder = 'FILL_THIS_IN' + line, replacement_done = self._fill_in_variable( + line=line, + varname=varname, + value=replacements[varname], + placeholder=this_placeholder) + if replacement_done: + counts[varname] += 1 + break + new_file.write(line) + + for varname in counts: + expect(counts[varname] > 0, + 'Did not find any instances of <{}> to replace in {}'.format(varname, filepath)) + + def _fill_in_variable(self, line, varname, value, placeholder): + """Fill in a placeholder variable in a config or namelist file + + Returns a tuple: (newline, replacement_done) + - newline is the line with the given placeholder replaced with the given value if this + line is for varname; otherwise returns line unchanged + - replacement_done is True if the replacement was done, otherwise False + """ + if re.search(r'^ *{} *='.format(varname), line): + expect(placeholder in line, + 'Placeholder to replace ({}) not found in <{}>'.format(placeholder, line.strip())) + newline = line.replace(placeholder, value) + replacement_done = True + else: + newline = line + replacement_done = False + return (newline, replacement_done) + + def _runtime_inputs_dir(self): + return os.path.join(self._case.get_value('CASEROOT'), 'lilac_build', 'runtime_inputs') + + def _atm_driver_rundir(self): + return os.path.join(self._case.get_value('CASEROOT'), 'lilac_atm_driver', 'run') + + @staticmethod + def _run_build_cmd(cmd, exeroot, logfile): + """ + Runs the given build command, with output to the given logfile + + Args: + cmd: str (command to run) + exeroot: str (path to exeroot) + logfile: str (path to logfile) + """ + append_testlog(cmd) + run_cmd_no_fail(cmd, arg_stdout=logfile, combine_output=True, from_dir=exeroot) + with open(os.path.join(exeroot, logfile)) as lf: + append_testlog(lf.read()) + + def run_phase(self): + # This mimics a bit of what's done in the typical case.run. Note that + # case.get_mpirun_cmd creates a command that runs the executable given by + # case.run_exe. So it's important that (elsewhere in this test script) we create a + # link pointing from that to the atm_driver.exe executable. + lid = new_lid() + os.environ["OMP_NUM_THREADS"] = str(self._case.thread_count) + cmd = self._case.get_mpirun_cmd(allow_unresolved_envvars=False) + run_cmd_no_fail(cmd, from_dir=self._atm_driver_rundir()) + + self._link_to_output_files() + + def _link_to_output_files(self): + """Make links to the output files so that they appear in the directory expected by the test case + + Note: We do the run from a different directory in order to ensure that the run + isn't using any of the files that are staged by the test case in the standard run + directory. But then we need to create these links afterwards for the sake of + baseline generation / comparison. + """ + casename = self._case.get_value('CASE') + rundir = self._case.get_value('RUNDIR') + pattern = '{}*.nc'.format(casename) + + # First remove any old files from the run directory + old_files = glob.glob(os.path.join(rundir, pattern)) + for one_file in old_files: + os.remove(one_file) + + # Now link to new files + output_files = glob.glob(os.path.join(self._atm_driver_rundir(), pattern)) + for one_file in output_files: + file_basename = os.path.basename(one_file) + symlink_force(one_file, os.path.join(rundir, file_basename)) diff --git a/cime_config/buildlib b/cime_config/buildlib index 13de92d236..9e87bad732 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -20,6 +20,63 @@ from CIME.utils import run_cmd, expect logger = logging.getLogger(__name__) +############################################################################### +def _write_ctsm_mk(gmake, gmake_opts, makefile, exeroot, libroot): + """Writes a ctsm.mk file in exeroot. + + This file can be included by atmosphere model builds outside of cime. + """ + + cime_output_file = os.path.join(exeroot, 'cime_variables.mk') + # Set MODEL=driver because some link flags are set differently when MODEL=driver, and + # those are the ones we want here. + cmd = ("{gmake} write_include_and_link_flags OUTPUT_FILE={cime_output_file} " + "MODEL=driver {gmake_opts} -f {makefile} ").format( + gmake=gmake, cime_output_file=cime_output_file, gmake_opts=gmake_opts, makefile=makefile) + rc, out, err = run_cmd(cmd) + 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)) + + ctsm_mk_path = os.path.join(exeroot, 'ctsm.mk') + with open(ctsm_mk_path, 'w') as ctsm_mk: + ctsm_mk.write(""" +# ====================================================================== +# Include this file to get makefile variables needed to include / link +# LILAC/CTSM in an atmosphere model's build +# +# Variables of interest are: +# - CTSM_INCLUDES: add this to the compilation line +# - CTSM_LIBS: add this to the link line +# ====================================================================== + +# ====================================================================== +# The following CIME variables are meant for internal use, and generally +# should not be included directly in an atmosphere model's build. +# ====================================================================== + +""") + with open(cime_output_file) as infile: + ctsm_mk.write(infile.read()) + + ctsm_bld_dir = os.path.abspath(os.path.join(libroot, os.pardir)) + with open(ctsm_mk_path, 'a') as ctsm_mk: + ctsm_mk.write(""" +# ====================================================================== +# The following settings are meant for internal use, and generally +# should not be included directly in an atmosphere model's build. +# ====================================================================== + +CTSM_BLD_DIR = {ctsm_bld_dir} +CTSM_INC = $(CTSM_BLD_DIR)/clm/obj + +# ====================================================================== +# The following settings should be included in an atmosphere model's build. +# ====================================================================== + +CTSM_INCLUDES = $(CIME_ESMF_F90COMPILEPATHS) -I$(CIME_CSM_SHR_INCLUDE) -I$(CTSM_INC) +CTSM_LIBS = -L$(CTSM_BLD_DIR)/lib -lclm $(CIME_ULIBS) $(CIME_SLIBS) $(CIME_MLIBS) $(CIME_F90_LDFLAGS) +""".format(ctsm_bld_dir=ctsm_bld_dir)) + ############################################################################### def _main_func(): ############################################################################### @@ -29,10 +86,16 @@ def _main_func(): with Case(caseroot) as case: casetools = case.get_value("CASETOOLS") + makefile = os.path.join(casetools, "Makefile") lnd_root = case.get_value("COMP_ROOT_DIR_LND") gmake_j = case.get_value("GMAKE_J") gmake = case.get_value("GMAKE") + gmake_opts = get_standard_makefile_args(case) driver = case.get_value("COMP_INTERFACE").lower() + lilac_mode = case.get_value("LILAC_MODE") + + if lilac_mode == 'on': + driver = "lilac" #------------------------------------------------------- # create Filepath file @@ -40,6 +103,7 @@ def _main_func(): 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"), @@ -56,6 +120,13 @@ def _main_func(): os.path.join(lnd_root,"src","utils"), os.path.join(lnd_root,"src","cpl"), os.path.join(lnd_root,"src","cpl",driver)] + + if lilac_mode == 'on': + paths.append(os.path.join(lnd_root,"lilac","src")) + # If we want to build with a real river model (e.g., MOSART), we'll need + # to use its directories in place of stub_rof + paths.append(os.path.join(lnd_root,"lilac","stub_rof")) + with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) filepath.write("\n") @@ -65,15 +136,25 @@ def _main_func(): #------------------------------------------------------- complib = os.path.join(libroot,"libclm.a") - makefile = os.path.join(casetools, "Makefile") cmd = "{} complib -j {} MODEL=clm COMPLIB={} -f {} {}" \ - .format(gmake, gmake_j, complib, makefile, get_standard_makefile_args(case)) + .format(gmake, gmake_j, complib, makefile, gmake_opts) rc, out, err = run_cmd(cmd) 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)) + # ------------------------------------------------------------------------ + # for lilac usage, we need a file containing some Makefile variables (for the atmosphere model's build) + # ------------------------------------------------------------------------ + + if lilac_mode == 'on': + _write_ctsm_mk(gmake=gmake, + gmake_opts=gmake_opts, + makefile=makefile, + exeroot=case.get_value("EXEROOT"), + libroot=libroot) + ############################################################################### if __name__ == "__main__": diff --git a/cime_config/buildnml b/cime_config/buildnml index 9940de97a3..a33fadb864 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -50,7 +50,6 @@ def buildnml(case, caseroot, compname): clm_accelerated_spinup = case.get_value("CLM_ACCELERATED_SPINUP") 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") @@ -209,12 +208,12 @@ def buildnml(case, caseroot, compname): 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 %s -res %s %s -clm_start_type %s -envxml_dir %s -l_ncpl %s " + "%s %s -res %s %s -clm_start_type %s -envxml_dir %s " "-configuration %s -structure %s " "-lnd_frac %s -glc_nec %s -co2_ppmv %s -co2_type %s -config %s " "%s %s %s %s" %(cmd, _CIMEROOT, infile, din_loc_root, inputdata_file, ignore, start_ymd, clm_namelist_opts, - nomeg, usecase, lnd_grid, clmusr, start_type, caseroot, lnd_ncpl, + nomeg, usecase, lnd_grid, clmusr, start_type, caseroot, configuration, structure, lndfrac_file, glc_nec, ccsm_co2_ppmv, clm_co2_type, config_cache_file, clm_bldnml_opts, spinup, tuning, gridmask)) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index 4c2412a0e3..bc9f1d6c0a 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -3,6 +3,8 @@ r rh\d? h\d*.*\.nc$ + lilac_hi.*\.nc$ + lilac_atm_driver_h\d*.*\.nc$ e locfnh @@ -15,6 +17,8 @@ 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.lilac_hi.1976-01-01-00000.nc + casename.clm2.lilac_atm_driver_h0.0001-01.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 diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 388fcd88ee..545c17d9c4 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -46,6 +46,15 @@ Name of land component + + char + on,off + off + build_component_clm + env_build.xml + Flag to enable building the LILAC cap and coupling code + + char run_component_clm diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 6c552f8dc8..87349d0c24 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -499,6 +499,18 @@ HIST_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_MOSART_CISM2%EVOLVE_SWAV + + + I2000Ctsm50NwpSpAsRsGs + 2000_SATM_CLM50%NWP-SP_SICE_SOCN_SROF_SGLC_SWAV + + diff --git a/cime_config/config_tests.xml b/cime_config/config_tests.xml index 8a40ea9183..8a933581cf 100644 --- a/cime_config/config_tests.xml +++ b/cime_config/config_tests.xml @@ -1,19 +1,7 @@ @@ -47,6 +35,16 @@ SSP smoke CLM spinup test (only valid for CLM compsets with CLM45) $STOP_N + + CTSM test: Smoke test of building and running CTSM via LILAC. Grid and compset (and most case settings) are ignored. + + 1 + ndays + 11 + FALSE + FALSE + + CLM test: Verify that adding virtual glacier columns doesn't change answers 1 @@ -85,6 +83,14 @@ SSP smoke CLM spinup test (only valid for CLM compsets with CLM45) $STOP_N + + smoke CLM spinup test 1 diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index e03cbc2b3b..d1d395c2b0 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2013,6 +2013,18 @@ + + + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm index 3f5749e61f..410035f89c 100644 --- a/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm @@ -7,7 +7,6 @@ ! ! EXCEPTIONS: ! 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) diff --git a/cime_config/testdefs/testmods_dirs/clm/lilac/README b/cime_config/testdefs/testmods_dirs/clm/lilac/README new file mode 100644 index 0000000000..049407e30b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/lilac/README @@ -0,0 +1,4 @@ +This testmods directory inherits from the directory containing the +user_nl_ctsm file that is staged for users by the build_ctsm +script. Thus, tests using this testmod will include the settings that +users get by default in LILAC configurations. diff --git a/cime_config/testdefs/testmods_dirs/clm/lilac/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/lilac/include_user_mods new file mode 100644 index 0000000000..7b5f17cf20 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/lilac/include_user_mods @@ -0,0 +1 @@ +../../../../usermods_dirs/lilac diff --git a/cime_config/testdefs/testmods_dirs/clm/lilac/user_nl_ctsm b/cime_config/testdefs/testmods_dirs/clm/lilac/user_nl_ctsm new file mode 100644 index 0000000000..740014baa9 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/lilac/user_nl_ctsm @@ -0,0 +1,3 @@ + hist_ndens = 1,1,1,1,1,1 + hist_nhtfrq(1) = -24 + hist_mfilt(1) = 1 diff --git a/cime_config/user_nl_clm b/cime_config/user_nl_clm index cfc5c71308..a333f1a603 100644 --- a/cime_config/user_nl_clm +++ b/cime_config/user_nl_clm @@ -9,7 +9,6 @@ ! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting ! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup 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) diff --git a/cime_config/usermods_dirs/_includes/output_base/user_nl_clm b/cime_config/usermods_dirs/_includes/output_base/user_nl_clm index 52254161ef..15d7680c31 100644 --- a/cime_config/usermods_dirs/_includes/output_base/user_nl_clm +++ b/cime_config/usermods_dirs/_includes/output_base/user_nl_clm @@ -9,7 +9,6 @@ ! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting ! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup 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) diff --git a/cime_config/usermods_dirs/lilac/README b/cime_config/usermods_dirs/lilac/README new file mode 100644 index 0000000000..c87aee3af4 --- /dev/null +++ b/cime_config/usermods_dirs/lilac/README @@ -0,0 +1,2 @@ +The user_nl_ctsm file in this directory is copied to the runtime_inputs +directory when setting up a LILAC build using build_ctsm. diff --git a/cime_config/usermods_dirs/lilac/user_nl_ctsm b/cime_config/usermods_dirs/lilac/user_nl_ctsm new file mode 100644 index 0000000000..5ff40dbff8 --- /dev/null +++ b/cime_config/usermods_dirs/lilac/user_nl_ctsm @@ -0,0 +1,17 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! (Exceptions are settings that are set in ctsm.cfg.) +!---------------------------------------------------------------------------------- + +! The following hist options set up three output streams from CTSM. The first (h0 files) +! is monthly and contains all of CTSM's default output variables. The second (h1 files) is +! daily, with a small list of fields given by hist_fincl2. The third (h2 files) is hourly, +! with a small list of fields given by hist_fincl3. You can change these settings however +! you'd like. +hist_mfilt = 1,1,24 +hist_nhtfrq = 0,-24,-1 +hist_fincl2 = 'SNO_LIQH2O','SNO_ICE','SNOTTOPL','SNOW_DEPTH','TSA','RAIN','SNOW','Q2M','RH2M','FSH','FCTR','FCEV','FGEV','FSDS','FSR','FIRA','BTRAN','SOILWATER_10CM','TSOI_10CM','H2OSOI','TSOI' +hist_fincl3 = 'SNO_LIQH2O','SNO_ICE','SNOTTOPL','SNOW_DEPTH','TSA','RAIN','SNOW','Q2M','RH2M','FSH','FCTR','FCEV','FGEV','FSDS','FSR','FIRA','BTRAN','SOILWATER_10CM','TSOI_10CM','H2OSOI','TSOI' + diff --git a/doc/ChangeLog b/doc/ChangeLog index 045c26ec2f..c08274e32e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,139 @@ =============================================================== +Tag name: ctsm1.0.dev104 +Originator(s): sacks (Bill Sacks) +Date: Mon Jul 6 09:58:15 MDT 2020 +One-line Summary: Add LILAC + +Purpose of changes +------------------ + +Add LILAC: The Lightweight Infrastructure for Land-Atmosphere +Coupling. This infrastructure consists of two major pieces: + +(1) A lightweight coupling infrastructure built on top of ESMF that + makes it easier for atmosphere models to call CTSM directly, rather + than using the hub-and-spoke architecture that is used by CESM. + +(2) A set of python-based tools for building CTSM and creating its + runtime inputs when running in an atmosphere model via + LILAC. Although these tools are built on top of cime, details of the + create_newcase / case.setup / case.build process are hidden from the + user, because many of the aspects of this workflow don't make sense + in the LILAC context. + +So far we have used LILAC to couple CTSM to WRF. There are plans to use +the same infrastructure to couple CTSM to other regional atmosphere +models. + +Documentation of LILAC is provided in +https://escomp.github.io/ctsm-docs/versions/master/html/lilac/index.html +(though there are still some missing sections), as well as in various +presentations on the wiki +(https://github.com/ESCOMP/CTSM/wiki/Presentations). + +There have been many contributors besides myself to the development, +testing and documentation of LILAC; chief among them being Mariana +Vertenstein, Negin Sobhani, Joe Hamman, Sam Levis, Mike Barlage and Dave +Lawrence. + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +- See issues in the Done column of https://github.com/ESCOMP/CTSM/projects/23 + +Known bugs introduced in this tag (include github issue ID): +- Although LILAC is working to first order, there is still some work to +do. See outstanding issues in https://github.com/ESCOMP/CTSM/projects/23 + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): none + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): +- dtime no longer specified on the namelist: just obtained from driver + +Changes made to namelist defaults (e.g., changed parameter values): none + +Changes to the datasets (e.g., parameter, surface or initial files): none + +Substantial timing or memory changes: none + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): none + +Changes to tests or testing: +- Added LILACSMOKE test + +Code reviewed by: self + + +CTSM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - ok + + Baseline comparisons fail as expected. One test failed, but it also + failed for me on master (https://github.com/ESCOMP/CTSM/issues/1074) + + tools-tests (test/tools): + + cheyenne - not run + + PTCLM testing (tools/shared/PTCLM/test): + + cheyenne - not run + + python testing (see instructions in python/README.md; document testing done): + + (any machine) - pass on my mac + + regular tests (aux_clm): + + cheyenne ---- pass + izumi ------- pass + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: NO + + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): none + +Pull Requests that document the changes (include PR ids): +https://github.com/ESCOMP/CTSM/pull/1068 + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev103 Originator(s): slevis (Samuel Levis, SLevis Consulting LLC,303-665-1310) Date: Mon Jun 29 17:16:29 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 9af125f5b9..c773cf9101 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev104 sacks 07/06/2020 Add LILAC ctsm1.0.dev103 slevis 06/29/2020 Gridcell-level error-check for methane (CH4) ctsm1.0.dev102 erik/ole 06/26/2020 Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 ctsm1.0.dev101 ole/erik 06/17/2020 Changes from Keith to bring a list of variables to the parameter file diff --git a/doc/source/index.rst b/doc/source/index.rst index f7f35abeda..9a9d8016ef 100644 --- a/doc/source/index.rst +++ b/doc/source/index.rst @@ -3,10 +3,10 @@ You can adapt this file completely to your liking, but it should at least contain the root `toctree` directive. -Welcome to the CLM documentation +Welcome to the CTSM documentation ================================== -This document has two major sections. +This document has three major sections. .. toctree:: :maxdepth: 2 @@ -14,6 +14,7 @@ This document has two major sections. users_guide/index.rst tech_note/index.rst + lilac/index.rst Indices and tables ================== diff --git a/doc/source/lilac/calling-ctsm-from-atm/api-init-details.rst b/doc/source/lilac/calling-ctsm-from-atm/api-init-details.rst new file mode 100644 index 0000000000..9a9073d188 --- /dev/null +++ b/doc/source/lilac/calling-ctsm-from-atm/api-init-details.rst @@ -0,0 +1,11 @@ +.. _api-init-details: + +.. highlight:: shell + +================================================ + Details on the CTSM-LILAC initialization phase +================================================ + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/calling-ctsm-from-atm/api-overview.rst b/doc/source/lilac/calling-ctsm-from-atm/api-overview.rst new file mode 100644 index 0000000000..286d175758 --- /dev/null +++ b/doc/source/lilac/calling-ctsm-from-atm/api-overview.rst @@ -0,0 +1,11 @@ +.. _api-overview: + +.. highlight:: shell + +================================ + Overview of the CTSM-LILAC API +================================ + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/calling-ctsm-from-atm/api-run-details.rst b/doc/source/lilac/calling-ctsm-from-atm/api-run-details.rst new file mode 100644 index 0000000000..61575427b9 --- /dev/null +++ b/doc/source/lilac/calling-ctsm-from-atm/api-run-details.rst @@ -0,0 +1,11 @@ +.. _api-run-details: + +.. highlight:: shell + +===================================== + Details on the CTSM-LILAC run phase +===================================== + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/calling-ctsm-from-atm/index.rst b/doc/source/lilac/calling-ctsm-from-atm/index.rst new file mode 100644 index 0000000000..4c42740df3 --- /dev/null +++ b/doc/source/lilac/calling-ctsm-from-atm/index.rst @@ -0,0 +1,12 @@ +.. _calling-ctsm-from-atm: + +======================================= + Calling CTSM from an atmosphere model +======================================= + +.. toctree:: + :maxdepth: 2 + + api-overview.rst + api-init-details.rst + api-run-details.rst diff --git a/doc/source/lilac/index.rst b/doc/source/lilac/index.rst new file mode 100644 index 0000000000..3aac77f9ef --- /dev/null +++ b/doc/source/lilac/index.rst @@ -0,0 +1,13 @@ +.. _lilac-users-guide: + +####################### +CTSM-LILAC User's Guide +####################### + +.. toctree:: + :maxdepth: 2 + + introduction-and-overview/index.rst + obtaining-building-and-running/index.rst + calling-ctsm-from-atm/index.rst + specific-atm-models/index.rst diff --git a/doc/source/lilac/introduction-and-overview/index.rst b/doc/source/lilac/introduction-and-overview/index.rst new file mode 100644 index 0000000000..4c2878797e --- /dev/null +++ b/doc/source/lilac/introduction-and-overview/index.rst @@ -0,0 +1,11 @@ +.. _introduction-and-overview: + +==================================== + Introduction and overview of LILAC +==================================== + +.. toctree:: + :maxdepth: 2 + + overview-of-lilac.rst + organization-of-documentation.rst diff --git a/doc/source/lilac/introduction-and-overview/organization-of-documentation.rst b/doc/source/lilac/introduction-and-overview/organization-of-documentation.rst new file mode 100644 index 0000000000..7a91c6ee54 --- /dev/null +++ b/doc/source/lilac/introduction-and-overview/organization-of-documentation.rst @@ -0,0 +1,28 @@ +.. _organization-of-documentation: + +.. highlight:: shell + +=================================== + Organization of the documentation +=================================== + +This documentation is organized into the following high-level sections: + +- :numref:`{number}. {name} `: This section gives a general + introduction to LILAC and describes the organization of this documentation (you're + reading this now!) + +- :numref:`{number}. {name} `: This section provides + instructions for building and running CTSM within an atmosphere model that has been set + up to run with CTSM (e.g., WRF). If you are starting to use CTSM with an atmosphere + model that does not yet have any calls to CTSM-LILAC, then you should start with section + :numref:`{number}. {name} `. + +- :numref:`{number}. {name} `: This section provides details on the + Fortran code that needs to be added to an atmosphere model in order to call CTSM via + LILAC as its land surface scheme. (In practice, this step comes before + :numref:`{number}. {name} `, but it is included later in + the documentation because it is of interest to fewer people.) + +- :numref:`{number}. {name} `: This section provides notes on running + CTSM within specific atmosphere models. diff --git a/doc/source/lilac/introduction-and-overview/overview-of-lilac.rst b/doc/source/lilac/introduction-and-overview/overview-of-lilac.rst new file mode 100644 index 0000000000..545386ee93 --- /dev/null +++ b/doc/source/lilac/introduction-and-overview/overview-of-lilac.rst @@ -0,0 +1,11 @@ +.. _overview-of-lilac: + +.. highlight:: shell + +=================== + Overview of LILAC +=================== + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg b/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg new file mode 100644 index 0000000000..a0d2cf6d07 --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:3d86cfb661a03c99574ec626db8be97d8875884f1c3879db9cab935bd0dee7a7 +size 17275 diff --git a/doc/source/lilac/obtaining-building-and-running/index.rst b/doc/source/lilac/obtaining-building-and-running/index.rst new file mode 100644 index 0000000000..14dc6f40be --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/index.rst @@ -0,0 +1,12 @@ +.. _obtaining-building-and-running: + +================================================= + Obtaining, building and running CTSM with LILAC +================================================= + +.. toctree:: + :maxdepth: 2 + + obtaining-and-building-ctsm.rst + setting-ctsm-runtime-options.rst + restarting.rst diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst new file mode 100644 index 0000000000..a51dcfcf25 --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -0,0 +1,312 @@ +.. highlight:: shell + +.. _obtaining-and-building-ctsm: + +======================================= + Obtaining and building CTSM and LILAC +======================================= + +This section describes the process for obtaining and building the CTSM library and its +dependencies, and linking to these libraries in an atmosphere model's build. + +.. important:: + + This documentation only applies to the process where you are building CTSM with LILAC + for use in an atmosphere model that has *not* been integrated with CESM or CIME. If you + are using CTSM within CESM, or running CTSM in land-only mode with a data atmosphere, + then you should refer to the :ref:`general CTSM user's guide` as well as + the `CIME documentation`_. + +Quick start example / overview +============================== + +The basic process for obtaining and building CTSM is the following: + +Obtain CTSM by running:: + + git clone https://github.com/ESCOMP/CTSM.git + cd CTSM + ./manage_externals/checkout_externals + +Then build CTSM and its dependencies. On a machine that has been ported to CIME, the +command will look like this (example given for NCAR's ``cheyenne`` machine):: + + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --machine cheyenne --compiler intel + +and then, before building the atmosphere model:: + + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh + +On a machine that has *not* been ported to CIME, you will need to provide some additional +information. Run ``./lilac/build_ctsm -h`` for details, but the basic command will look +like this:: + + ./lilac/build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default --max-mpitasks-per-node 4 --no-pnetcdf + +In both cases, you will then need to include the necessary information in the include and +link lines of the atmosphere model's build. For a Makefile-based build, this can be done +by including the file ``/PATH/TO/CTSM/BUILD/ctsm.mk`` in the atmosphere model's build +scripts, then adding ``CTSM_INCLUDES`` to the include line and ``CTSM_LIBS`` to the link +line. + +Further details on these steps are given below. + +.. _building-ctsm-and-lilac-prerequisites: + +Prerequisites +============= + +Building CTSM requires: + +- a Unix-like operating system (Linux, AIX, OS X, etc.) + +- git version 1.8 or newer + +- python3 + + - Note that some scripts in the workflow look for 'python3' and others look for + 'python'. So python should be available under both of these names (although it is okay + for ``python`` to refer to version 2.7.x). + +- perl version 5 + +- a GNU version of the make tool (gmake) + +- CMake + +- Fortran and C compilers + + - See https://github.com/escomp/cesm#details-on-fortran-compiler-versions for + information on compiler versions known to work with CESM, and thus CTSM. + +- LAPACK and BLAS libraries + +- a NetCDF library version 4.3 or newer built with the same compiler you will use for CTSM + + - a PNetCDF library is optional + +- a functioning MPI environment + + - typically, this includes compiler wrappers like ``mpif90`` and ``mpicc`` + +- ESMF version 8 or later + + - **ESMF is not needed in general for CTSM, but is needed for LILAC** + +Obtaining CTSM +============== + +CTSM and its dependencies (excluding the :ref:`prerequisites noted +above`) can be obtained with:: + + git clone https://github.com/ESCOMP/CTSM.git + cd CTSM + ./manage_externals/checkout_externals + +By default, this will put you on the ``master`` branch of CTSM, which is the main +development branch. You can checkout a different branch or tag using ``git checkout``; +**be sure to rerun** ``./manage_externals/checkout_externals`` **after doing so.** + +For more details, see +https://github.com/ESCOMP/CTSM/wiki/Quick-start-to-CTSM-development-with-git + +Building CTSM and its dependencies +================================== + +Overview +-------- + +CTSM provides a build script, ``lilac/build_ctsm``, for building CTSM and its dependencies. (The +dependencies built with this build script include various libraries that are packaged with +CIME_. This does *not* build the :ref:`prerequisites noted +above`: it is assumed that those are already built +on your machine.) + +There are two possible workflows for building CTSM and its dependencies. The first works +if you are using a machine that has been ported to CIME_; the second works if you are +using a machine that has *not* been ported to CIME_. Both workflows are described +below. If you are using a machine that has not been ported to CIME, it is possible to do a +complete CIME port and then use the first workflow (by following the `CIME porting guide +`_), but +unless you need to do so for other reasons (such as running CESM, or running CTSM in a +land-only configuration forced by a data atmosphere, using the CIME_ scripting +infrastructure), it is generally simpler to use the second workflow below: A full CIME +port requires many settings that are not needed for just building CTSM. + +There is a third usage where you simply want to rebuild after making some source code +changes to CTSM. This is also documented below. + +All of these workflows use CIME's build system behind the scenes. Typically, you will not +need to be aware of any of those details, but if problems arise, you may want to consult +the `CIME documentation`_. + +.. _building-on-a-cime-supported-machine: + +Building on a CIME-supported machine +------------------------------------ + +If you are using a machine that has been ported to CIME_ (for example, NCAR's ``cheyenne`` +machine), then you do not need to specify much information to ``build_ctsm``. In addition, +in this case, CIME will load the appropriate modules and set the appropriate environment +variables at build time, so you do not need to do anything to set up your environment +ahead of time. **Building CTSM with LILAC requires ESMF. ESMF is currently an optional +CIME dependency, so many CIME-ported machines do not provide information on an ESMF +installation. NCAR's cheyenne machine DOES provide ESMF, but for other machines, you may +need to add this to your CIME port.** + +To build CTSM and its dependencies in this case, run:: + + ./lilac/build_ctsm /PATH/TO/CTSM/BUILD --machine MACHINE --compiler COMPILER + +where you should fill in the capitalized arguments with appropriate values for your +machine. + +.. note:: + + The given directory (``/PATH/TO/CTSM/BUILD``) must *not* exist. This directory is + created for you by the build script. + +Some other options to ``build_ctsm`` are supported in this case (but many are not, since +they are only applicable to the non-CIME-supported machine workflow); run +``./lilac/build_ctsm -h`` for details. + +.. important:: + + If PNetCDF (parallel NetCDF) is not available on this machine, you will need to add the + option ``--no-pnetcdf``. + + If you plan to run with OpenMP threading-based parallelization, or hybrid MPI/OpenMP, + then it is important to add ``--build-with-openmp``. + +Besides the build files themselves, ``build_ctsm`` creates the following important files +that are needed for the build of the atmosphere model: + +1. ``/PATH/TO/CTSM/BUILD/ctsm.mk``: This Makefile-formatted file gives variables that + should be set in the atmosphere model's build. :ref:`See below for information on how + to use this file`. + +2. ``/PATH/TO/CTSM/BUILD/ctsm_build_environment.sh`` or + ``/PATH/TO/CTSM/BUILD/ctsm_build_environment.csh``: These files specify the build + environment that CIME used to build CTSM and its dependencies. **Before building the + atmosphere model, you should source the appropriate file** (based on your shell - use + the ``.sh`` file for bash and similar shells, and the ``.csh`` file for tcsh and + similar shells). **This will ensure that the atmosphere model is built with the same + compiler and library versions as CTSM.** For example, with bash: ``source + /PATH/TO/CTSM/BUILD/ctsm_build_environment.sh``. + +Building on a machine that has not been ported to CIME +------------------------------------------------------ + +If you are using a machine thata has not been ported to CIME_, then you need to specify +additional information to ``build_ctsm`` that is needed by the build system. Before +building CTSM, you should load any modules and/or set any environment variables required +by the atmosphere model or CTSM builds, including all of the :ref:`prerequisites noted +above`. + +The minimal amount of information needed is given by the following:: + + ./lilac/build_ctsm /PATH/TO/CTSM/BUILD --os OS --compiler COMPILER --netcdf-path NETCDF_PATH --esmf-lib-path ESMF_LIB_PATH --max-mpitasks-per-node MAX_MPITASKS_PER_NODE --pnetcdf-path PNETCDF_PATH + +where you should fill in the capitalized arguments with appropriate values for your +machine. Run ``./lilac/build_ctsm -h`` for details on these arguments, as well as documentation +of additional, optional arguments. Some of these optional arguments may be needed for +successful compilation, while others (such as ``--pnetcdf-path``) may be needed for good +model performance. + +.. note:: + + The given directory (``/PATH/TO/CTSM/BUILD``) must *not* exist. This directory is + created for you by the build script. + +.. important:: + + If PNetCDF (parallel NetCDF) is not available on your machine/compiler, you should use + the option ``--no-pnetcdf`` instead of ``--pnetcdf-path``. You must specify exactly one + of those two options. + + If you plan to run with OpenMP threading-based parallelization, or hybrid MPI/OpenMP, + then it is important to add ``--build-with-openmp``. + +Example usage for a Mac (a simple case) is:: + + ./lilac/build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default --max-mpitasks-per-node 4 --no-pnetcdf + +Example usage for NCAR's ``cheyenne`` machine (a more complex case) is:: + + module purge + module load ncarenv/1.3 intel/19.0.5 esmf_libs mkl + module use /glade/work/himanshu/PROGS/modulefiles/esmfpkgs/intel/19.0.5 + module load esmf-8.1.0b14-ncdfio-mpt-O mpt/2.21 netcdf/4.7.3 pnetcdf/1.12.1 ncarcompilers/0.5.0 + module load python + + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --os linux --compiler intel --netcdf-path '$ENV{NETCDF}' --pio-filesystem-hints gpfs --pnetcdf-path '$ENV{PNETCDF}' --esmf-lib-path '$ENV{ESMF_LIBDIR}' --max-mpitasks-per-node 36 --extra-cflags '-xCORE_AVX2 -no-fma' --extra-fflags '-xCORE_AVX2 -no-fma' + +(It's better to use the :ref:`alternative process for a CIME-supported +machine` in this case, but the above illustrates +what would be needed for a machine similar to this that has not been ported to CIME.) + +Besides the build files themselves, ``build_ctsm`` creates an important file that is +needed for the build of the atmosphere model: ``/PATH/TO/CTSM/BUILD/ctsm.mk``. This +Makefile-formatted file gives variables that should be set in the atmosphere model's +build. :ref:`See below for information on how to use this +file`. + + +Rebuilding after changing CTSM source code +------------------------------------------ + +To rebuild after changing CTSM source code, you should follow one of the above workflows, +but the ``build_ctsm`` command will simply be:: + + ./lilac/build_ctsm /PATH/TO/CTSM/BUILD --rebuild + +where ``/PATH/TO/CTSM/BUILD`` should point to the same directory you originally used. + +.. _including-ctsm-in-the-atmosphere-model-build: + +Including CTSM in the atmosphere model's build +============================================== + +Once you have successfully built CTSM and its dependencies, you will need to add various +paths to the compilation and link lines when building your atmosphere model. For a +Makefile-based build system, we facilitate this by producing a file, +``/PATH/TO/CTSM/BUILD/ctsm.mk``, which you can include in your own build script. (We do +not yet produce an equivalent for CMake or other build systems.) + +There are two important variables defined in this file: + +- ``CTSM_INCLUDES``: This variable should be included in the compilation line for the + atmosphere model's source files. It lists all paths that need to be included in these + compilations so that the compiler can find the appropriate Fortran module files. + +- ``CTSM_LIBS``: This variable should be included in the link line when creating the final + executable. It lists paths and library names that need to be included in the link + step. **Note: This may not include all of the libraries that are** + :ref:`prerequisites`, **such as LAPACK, BLAS and + NetCDF. If your atmosphere doesn't already require these, you may need to add + appropriate information to your atmosphere model's link line.** However, it should + already include all required link information for ESMF. + +Other variables in this file do not need to be included directly in the atmosphere model's +build (they are just intermediate variables used to create ``CTSM_INCLUDES`` and +``CTSM_LIBS``). + +For example, for the WRF build, we do the following: If building with CTSM, then we +expect that the user has set an environment variable:: + + export WRF_CTSM_MKFILE=/PATH/TO/CTSM/BUILD/ctsm.mk + +If that environment variable exists, then the ``configure`` script adds the following to +the Makefile-based build: + +- Includes the ``ctsm.mk`` file (like ``include ${WRF_CTSM_MKFILE}``) + +- Adds a CPP definition, ``-DWRF_USE_CTSM``, which is used to do conditional compilation + of the CTSM-LILAC interface code + +- Adds ``$(CTSM_INCLUDES)`` to its variable ``INCLUDE_MODULES`` + +- Adds ``$(CTSM_LIBS)`` to its variable ``LIB`` + +.. _CIME: http://esmci.github.io/cime +.. _CIME documentation: http://esmci.github.io/cime diff --git a/doc/source/lilac/obtaining-building-and-running/restarting.rst b/doc/source/lilac/obtaining-building-and-running/restarting.rst new file mode 100644 index 0000000000..e5e6c4ae1b --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/restarting.rst @@ -0,0 +1,30 @@ +.. highlight:: shell + +.. _restarting: + +===================================== + Continuing a run from restart files +===================================== + +All of the information that CTSM and LILAC need to continue a run from restart files is +given in the restart files themselves. No namelist changes need to be made (other than +whatever is needed in the host atmosphere model), but the ``starttype_in`` argument to the +``lilac_init2`` subroutine call from the atmosphere model will need to be changed to +"continue" rather than "startup". + +CTSM and LILAC use ``rpointer`` files to indicate the specific restart files that should +be read. These files, ``rpointer.lnd`` and ``rpointer.lilac``, are one-line text files +that simply specify the name of the respective restart files. When restart files are +written (according to the ``write_restarts_now`` argument to the ``lilac_run`` +subroutine), these ``rpointer`` files are updated to point to the latest set of restarts. + +If you want to restart from the latest set of restart files, the ``rpointer`` files should +already be set up to facilitate this. However, if you want to restart from an earlier set +of restarts, you can simply edit ``rpointer.lnd`` and ``rpointer.lilac`` to point to the +appropriate restart files. + +.. important:: + + Be sure that the ``rpointer.lnd`` and ``rpointer.lilac`` files point to restart files + from the same time as each other, and from the same time as the atmosphere model's + restart time. diff --git a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst new file mode 100644 index 0000000000..a338324e07 --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst @@ -0,0 +1,261 @@ +.. highlight:: shell + +.. _setting-ctsm-runtime-options: + +============================== + Setting CTSM runtime options +============================== + +Overview and quick start +======================== + +This section describes the process for creating the runtime input text files for CTSM and +LILAC. These files, which are in Fortran namelist format, have hard-coded file +names. These files must exist with the expected names in the directory from which the +model is run: + +- ``lnd_in``: This is the main namelist input file for CTSM + +- ``lnd_modelio.nml``: This sets CTSM's PIO (parallel i/o library) configuration settings + +- ``lilac_in``: This namelist controls the operation of LILAC + +.. note:: + + There are a number of other required runtime input files to both CTSM and LILAC, in + NetCDF format. The paths to these other files are specified in either ``lnd_in`` or + ``lilac_in``. + +The basic process for creating the necessary input files is the following; this process is +also illustrated in :numref:`Figure ctsm_lilac_runtime_file_workflow`: + +#. Run the ``build_ctsm`` script described in section + :numref:`obtaining-and-building-ctsm`. In addition to building CTSM, this also stages + the necessary files in the ``runtime_inputs`` subdirectory of your specified build + directory. Then ``cd`` to this ``runtime_inputs`` subdirectory to do the following + steps (it is fine to do these steps even while CTSM is still building). + +#. Modify the ``ctsm.cfg`` file to set high-level options to CTSM. (A few options need to + be set; most can be left at their default values or changed if desired.) Optionally, + also set specific namelist values in ``user_nl_ctsm``. + +#. Run the script, ``make_runtime_inputs``. (This creates the files ``lnd_in`` and + ``clm.input_data_list``.) + +#. Modify ``lilac_in`` as needed. (Typically you will only need to set values for + ``atm_mesh_filename`` and ``lnd_mesh_filename``; other variables can typically be kept + at their default values.) + +#. Run the script, ``download_input_data`` to download any of CTSM's standard input files + that are needed based on settings in ``lnd_in`` and ``lilac_in``. (This step may be + unnecessary if all of the needed input data already exists. However, it doesn't hurt to + run it in this case.) + +#. Copy ``lnd_in``, ``lnd_modelio.nml`` and ``lilac_in`` to the directory from which you + will be running the model. + +.. _Figure ctsm_lilac_runtime_file_workflow: + +.. figure:: ctsm_lilac_runtime_file_workflow.* + + CTSM/LILAC runtime file workflow. Files in blue can be (and in some cases must be) + edited before running the next step. Files in purple (with italicized names) should + **not** be edited directly. + +More details on these steps are given in the following subsections. + +Creating initial runtime inputs with build_ctsm +=============================================== + +The ``build_ctsm`` script, which is described in detail in section +:numref:`obtaining-and-building-ctsm`, creates initial runtime input files in addition to +building the model. This script creates a number of files in the ``runtime_inputs`` +subdirectory of the specified build directory. For a few variables in these runtime input +files, ``build_ctsm`` sets initial values based on options provided to this +script. Important options for these runtime inputs include ``--no-pnetcdf``, +``--inputdata-path`` and ``--max-mpitasks-per-node``. (Run ``build_ctsm`` with the ``-h`` +or ``--help`` option for more information.) + +Once this script creates and populates the ``runtime_inputs`` subdirectory, it is safe to +proceed with the following steps, even if CTSM has not finished building. + +For the following steps, you should ``cd`` to this ``runtime_inputs`` subdirectory. + +Modifying ctsm.cfg and user_nl_ctsm +=================================== + +CTSM has hundreds of runtime parameters. Most of these parameters can be set individually, +but in many cases it makes more sense to think in terms of high-level options. These +high-level options set groups of parameters, creating configurations that the core CTSM +developers feel are useful - and these standard configurations are generally tested both +from a scientific and software perspective. + +The two text files, ``ctsm.cfg`` and ``user_nl_ctsm``, together with CTSM's scripting +infrastructure and XML database controlled by the ``make_runtime_inputs`` script, work +together to allow you to configure CTSM's runtime parameters at both a high level and +individually. + +ctsm.cfg +-------- + +``ctsm.cfg`` controls high-level options that, in many cases, set the default values for +multiple individual runtime parameters. All of the available high-level options appear in +this file; you can change the values of variables, but cannot add or remove any variables +in this file. + +The first set of options in this file specifies key file names: + +- ``lnd_domain_file`` must be specified. This file specifies CTSM's grid and land + mask. The general process for creating this file is described in section + :numref:`creating-domain-files`. + +- ``fsurdat`` also must be specified. This file specifies a variety of spatially-varying + properties. This file is grid-specific, but can be created from grid-independent files + using CTSM's toolchain described in section :numref:`creating-surface-datasets`. + +- ``finidat`` should generally be specified, although it's not absolutely essential. This + file specifies CTSM's initial conditions. If this isn't specified, the model will use a + standard set of initial conditions, interpolated to your grid. However, particularly for + NWP / prediction applications, you will typically want a customized initial condition + file. The process for generating this file will depend on your atmosphere model and + workflow, but an example for WRF is given in section + :numref:`wrf-create-input-namelists-for-ctsm-and-lilac`. + +The remainder of this file specifies a variety of high-level options, each of which sets +the default values for a number of CTSM's runtime parameters. The default values should be +reasonable starting points, but you may want to configure these. Details on these options +and allowed values are given in comments in ``ctsm.cfg``. + +user_nl_ctsm +------------ + +This file allows you to override individual CTSM namelist variables. This includes +variables whose default values are set based on settings in ``ctsm.cfg`` and others. The +file is initially populated with some settings controlling CTSM's diagnostic (history) +file output. These pre-populated settings can be changed, and additional settings can be +added to this file. + +There is some documentation of these settings in section :numref:`customizing-a-case`, and +in the `CESM release documentation +`_, but note that +the latter is slightly out of date with respect to the latest version of CTSM. An easy way +to see the list of available variables is to run ``make_runtime_inputs`` in order to +generate an initial ``lnd_in`` file; most of the variables given in that file can be +specified in ``user_nl_ctsm``, and then ``make_runtime_inputs`` can be rerun. **As noted +below, it is better NOT to edit the** ``lnd_in`` **file directly, instead using the +workflow documented here.** + +Running make_runtime_inputs +=========================== + +Once you have made the modifications you want to ``ctsm.cfg`` and ``user_nl_ctsm``, run +the script ``make_runtime_inputs`` from the ``runtime_inputs`` directory. This takes +``ctsm.cfg`` and ``user_nl_ctsm`` as inputs, and generates two output files: ``lnd_in`` +and ``clm.input_data_list``. ``lnd_in`` will be read by CTSM. ``clm.input_data_list`` is +an automatic extraction of a subset of ``lnd_in`` specifying the paths of various other +input files that will be needed by CTSM; this is used by the ``download_input_data`` +script to automatically download the relevant files. + +It is safe to rerun ``make_runtime_inputs`` as often as you want, incrementally changing +``ctsm.cfg`` and/or ``user_nl_ctsm``. + +.. important:: + + We recommend that you do NOT modify ``lnd_in`` directly. Instead, to make changes to + the ``lnd_in`` file, you should modify ``user_nl_ctsm`` and rerun + ``make_runtime_inputs``. There are a few reasons for following this workflow: + + - Hand edits to ``lnd_in`` will be lost if you later rerun ``make_runtime_inputs``, + whereas edits to ``user_nl_ctsm`` will be maintained. + + - ``make_runtime_inputs`` performs various validations of the contents of + ``user_nl_ctsm``; these validations would be bypassed if you edited ``lnd_in`` + directly. + + - If you change any file paths, ``make_runtime_inputs`` will ensure that + ``clm.input_data_list`` remains in sync with ``lnd_in``. + +Modifying lilac_in +================== + +Unlike ``lnd_in``, the ``lilac_in`` file can be hand-edited. Most of the settings in this +file can be left at their default values, but there are two variables whose values you +must set (as indicated by their default values, ``FILL_THIS_IN``): + +- ``atm_mesh_filename``: This should specify the path to an ESMF mesh file describing the + atmosphere model's grid. + +- ``lnd_mesh_filename``: This should specify the path to an ESMF mesh file describing the + land model's grid. If the land model is running on the same grid as the atmosphere + model (which is typical), this can be the same file as ``atm_mesh_filename``. + +Other settings you may want to change are: + +- Settings in ``lilac_history_input``: ``lilac_histfreq_option`` and + ``lilac_histfreq_n``. Together, these specify the output frequency from LILAC + itself. Note that this is separate from CTSM's output: LILAC's output contains + instantaneous snapshots of the fields passed from the atmosphere to CTSM and vice + versa, whereas CTSM's output is much more extensive. For many purposes, it's fine to + leave LILAC's output turned off (as is the default). Allowable options for + ``lilac_histfreq_option`` are ``never``, ``nsteps``, ``nseconds``, ``nminutes``, + ``nhours``, ``ndays``, ``nmonths`` and ``nyears``. + +- Settings in ``atmaero_stream``: These specify a dataset containing atmospheric aerosols, + for the (typical) case where the atmosphere model is not sending these aerosols itself. + +Running download_input_data +=========================== + +CTSM requires a variety of runtime input files in NetCDF format. These files are listed in +the ``lnd_in`` file, and are consolidated in the file ``clm.input_data_list`` (which is +produced by ``make_runtime_inputs``). In addition, a few other NetCDF files are listed in +``lilac_in``, of which the file listed in ``atmaero_stream`` is typically a standard input +file (as opposed to one that you, the user, has provided). + +CTSM's standard input files are expected to be in subdirectories of an ``inputdata`` +directory. With the ``build_ctsm`` workflow, this ``inputdata`` directory can be found +under the specified build directory. Depending on the options used for ``build_ctsm``, +this may be a new directory or it may be a symbolic link to an existing directory. These +standard input files are stored on a number of publicly available servers, such as +https://svn-ccsm-inputdata.cgd.ucar.edu/trunk/inputdata/. + +As a convenience, we provide a tool to obtain all of the needed standard input files for +your configuration: **To download these files to their expected locations, simply run** +``download_input_data`` **from the** ``runtime_inputs`` **directory.** This script reads +the file names from ``clm.input_data_list`` and ``lilac_in`` to determine which files need +to be downloaded. + +You will likely get some messages like, "Cannot download file since it lives outside of +the input_data_root", possibly followed by a final message, "Could not find all inputdata +on any server". As long as these messages just refer to your custom, resolution-specific +files (and not to CTSM's standard input files), then this is nothing to worry about. + +Copying the necessary files to the model's run directory +======================================================== + +Finally, copy the following files to the directory from which you will run the model: + +- ``lnd_in``: This is the main namelist input file for CTSM + +- ``lnd_modelio.nml``: This sets CTSM's PIO (parallel i/o library) configuration settings + +- ``lilac_in``: This namelist controls the operation of LILAC + +.. note:: + + We have not discussed ``lnd_modelio.nml`` above. This is because, if you have run + ``build_ctsm`` with appropriate options, then you shouldn't need to make any changes to + this file. However, you may want to confirm that two settings, in particular, are set + correctly for your machine; these can be important for I/O performance: + + - ``pio_stride``: this should generally be set to the number of physical processors per + shared-memory node on your machine. This is set from the ``--max-mpitasks-per-node`` + argument for a user-defined machine; it should be set automatically for a machine + that has been ported to CIME. + + - ``pio_typename``: this should generally be set to either ``pnetcdf`` or + ``netcdf``. Using PNetCDF (Parallel NetCDF) can result in significantly better I/O + performance, but this is only possible if you have the PNetCDF library on your + machine. The default for this variable is controlled by the ``--no-pnetcdf`` argument + to ``build_ctsm``, but you can change it here if you mistakenly set or didn't set + ``--no-pnetcdf`` when running ``build_ctsm``. diff --git a/doc/source/lilac/specific-atm-models/index.rst b/doc/source/lilac/specific-atm-models/index.rst new file mode 100644 index 0000000000..04a1976253 --- /dev/null +++ b/doc/source/lilac/specific-atm-models/index.rst @@ -0,0 +1,10 @@ +.. _specific-atm-models: + +===================================== + Notes on specific atmosphere models +===================================== + +.. toctree:: + :maxdepth: 2 + + wrf.rst diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst new file mode 100644 index 0000000000..cb590f24fc --- /dev/null +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -0,0 +1,371 @@ +.. _wrf: + +.. highlight:: shell + +===================== + Using CTSM with WRF +===================== + +This section includes instructions on how to use WRF with CTSM using LILAC. +The procedure for building and running the CTSM library and its dependencies +repeats some information from earlier sections but with minimal explanation. + +.. important:: + + This section assumes use of a machine that has been ported to CIME. + In this example we assume NCAR’s cheyenne computer in particular. + + +Clone WRF and CTSM Repositories +------------------------------- + +Clone the WRF CTSM feature branch:: + + git clone https://github.com/billsacks/WRF.git + cd WRF + git checkout lilac_dev + +.. todo:: + + update the git address to WRF feature branch... + +Clone the CTSM repository:: + + git clone https://github.com/ESCOMP/CTSM.git + cd CTSM + git checkout lilac_cap + ./manage_externals/checkout_externals + +.. todo:: + + Remove "git checkout lilac_cap" from the above when ready + + +Build CTSM and its dependencies +------------------------------- + +Build CTSM and its dependencies based on the instructions from previous sections :: + + ./lilac/build_ctsm /PATH/TO/CTSM/BUILD --machine MACHINE --compiler COMPILER + +For example on `Cheyenne:` for `Intel` compiler:: + + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne + + +.. note:: + + Run ./lilac/build_ctsm -h to see all options available, + for example if you would like to run with threading support you can use `--build-with-openmp` + +.. warning:: + + The directory you provided for the build script (``/PATH/TO/CTSM/BUILD``) must *not* exist. + Alternatively, you can use ``--rebuild`` option. + +Building WRF with CTSM +---------------------- + +First, load the same modules and set the same environments as used for CTSM build by +sourcing ctsm_build_environment.sh for Bash:: + + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh + +or sourcing ctsm_build_environment.csh for Cshell: + +.. code-block:: Tcsh + + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh + +Set makefile variables from CTSM needed for the WRF build by setting the following environment. +For example for Bash:: + + export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + +or for Cshell: + +.. code-block:: Tcsh + + setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + + +There are also few other environmental setting that should be set for building WRF. +Some of these are not required, but might help if you face any compilation errors. +For more information check WRF Users' Guide. + + +Explicitly define which model core to build by (Bash):: + + export WRF_EM_CORE=1 + +or (Cshell): + +.. code-block:: Tcsh + + setenv WRF_EM_CORE 1 + + +Explicilty turn off data assimilation by:: + + export WRF_DA_CORE=0 + +or (Cshell): + +.. code-block:: Tcsh + + setenv WRF_DA_CORE 0 + +Now configure and build WRF for your machine and intended compiler:: + + ./clean -a + ./configure + + +At the prompt choose one of the options, based on the compiler used +for building CTSM. Then you should choose if you'd like to build serially or +in parallel. + +.. tip:: + + dmpar or distributed memory parallelization is the most highly tested and + recommended for compiling WRF. + +The next prompt requests an option for nesting. Currently nesting is not +available for WRF-CTSM so enter 1. + + +Now compile em_real and save the log:: + + ./compile em_real >& compile.log + + +Check the bottom of your log file for a successful compilation message +or search the file for the string "Error" with a capital E. + +.. note:: + + The ./compile step may take more than 30 minutes to complete. + While you wait, follow the instructions in Section 3.2.2 (next) + +.. tip:: + + Optional: One may use ``tmux`` or ``nohup`` for configuring and compiling. + Try ``man nohup`` for more information. + +.. seealso:: + + For further detail on preparing the CTSM, including how to + recompile when making code changes to the CTSM, read `Section 3.2. + `__ + +Compile WRF Preprocessing System (WPS) +-------------------------------------- + +The WRF Preprocessing System (WPS) is a set of programs to prepare +inputs to the real program executable (real.exe) for WRF real-data simulations. +If you wish to complete the offered example with preexisting inputs, then +skip to the next section, which is titled "Run WRF." + +.. warning:: + + Building WPS requires that WRF be already built successfully. + + +Get WPS from this website:: + + https://www2.mmm.ucar.edu/wrf/users/download/wrf-regist_or_download.php + +New users must complete a registration form in this step. + +Then compile WPS similar to the way WRF was built. In summary:: + + cd WPS + ./configure + +At the prompt choose your intended compiler and parallelization method, +similar to the steps in your WRF build. + +Then, compile WPS:: + + ./compile >& compile.log + +.. note:: + + If wps builds succesfully you should see geogrid.exe, ungrib.exe, and metgrid.exe. + Alternatively, you can check the log for successful build messages. + + +Run WPS Programs +---------------- + +Edit ``namelist.wps`` for your domain of interest, which should be the same +domain as used in your WRF namelist. + +First, use geogrid.exe to define the domain and interpolate static geographical data +to the grids:: + + ./geogrid.exe >& log.geogrid + +If the geogrid step finishes successfully, you should see the following message in the log file:: + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Successful completion of geogrid. ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +Next, run ungrib to get gribbed data into usable format to be ingested by WRF. + +To run ungrib.exe, first link the GRIB data files that are going to be used:: + + ./link_grib.csh $your_GRIB_data_path + +Based on your GRIB data type, link or copy the appropriate VTable to your WPS directory. +WRF has some prepared VTable under ``/ungrib/Variable_tables/`` folder. + +Extract meteorological fields from GRIB-formatted files:: + + ./ungrib.exe >& log.ungrib + +Check ungrib log for the following message showing successful completion of ungrib step:: + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Successful completion of ungrib. ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +At this point, you should see ungrib output (intermediate files) in your WPS directory. + +Horizontally interpolate the meteorological fields extracted by ungrib to +the model grids defined in geogrid:: + + ./metgrid.exe >& log.metgrid + + +Check the metgrid log for the following message showing successful completion of +metgrid step:: + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Successful completion of metgrid. ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + + +Run real.exe +------------ + +Run ``real.exe`` to generate initial and boundary conditions. + +Follow WRF instructions for creating initial and boundary conditions. +In summary, complete the following steps: + +Move or link WPS output files (``met_em.d01*`` files) to your WRF test directory. + +Edit namelist.input for your WRF domain and desirable configurations. +This should be the same domain as WPS namelist. + + +.. todo:: + + update the option number of wrf namelist. + + +To run WRF-CTSM, in your namelist change land-surface option to 51:: + + sf_surface_physics = 51 + + +.. todo:: + + add the link and adding some note that nested run is not possible.... + +Run real.exe (if compiled parallel submit a batch job) to generate +``wrfinput`` and ``wrfbdy`` files. + + +Check the last line of the real log file for the following message:: + + SUCCESS COMPLETE REAL_EM INIT + +Set CTSM runtime options +------------------------ + +Now follow the instructions in this Section:: + + https:../obtaining-building-and-running/setting-ctsm-runtime-options.html + +In step 3 of that Section we used for this example:: + + lnd_domain_file = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files/domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc + fsurdat = /glade/work/slevis/git_wrf/ctsm_surf/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc + finidat = /glade/work/slevis/git_wrf/ctsm_init/finidat_interp_dest_wrfinit_snow_ERAI_12month.nc + +In step 4 of that Section we used for this example:: + + atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + +In step 6 of that Section you will copy some files to your WRF/run +directory. Then you will be ready to continue. + +.. note:: + + If you wish to merge your WRF initial conditions from a wrfinput file + into the existing CTSM initial condition file, complete the following step. + +Type:: + + module load ncl + ncl transfer_wrfinput_to_ctsm_with_snow.ncl 'finidat="the_existing_finidat_file.nc"' 'wrfinput="your_wrfinput_file"' 'merged="the_merged_finidat_file.nc"' + +.. todo:: + + Make the above ncl script available. + + + +Run wrf.exe +----------- + +If real.exe completed successfully, we should have ``wrfinput`` and ``wrfbdy`` files +in our directory. + +If you plan to use this example's preexisting files, copy +the following files to your WRF/run directory:: + + /glade/work/slevis/git_wrf/WRF/test/em_real/namelist.input.ctsm.2013.d01.12month + /glade/work/slevis/git_wrf/WRF/test/em_real/wrfinput_d01.ERAI.12month + /glade/work/slevis/git_wrf/WRF/test/em_real/wrfbdy_d01.ERAI.12month + +Now run WRF-CTSM. On Cheyenne this means submitting a batch job to PBS (Pro workload management system). +For detailed instructions on running a batch job on Cheyenne, please check: +https://www2.cisl.ucar.edu/resources/computational-systems/cheyenne/running-jobs/submitting-jobs-pbs + +A simple PBS script to run WRF-CTSM on Cheyenne looks like this: + +.. code-block:: Tcsh + + #!/bin/tcsh + #PBS -N your_job_name + #PBS -A your_project_code + #PBS -l walltime=01:00:00 + #PBS -q queue_name + #PBS -j oe + #PBS -k eod + #PBS -m abe + #PBS -M your_email_address + #PBS -l select=2:ncpus=36:mpiprocs=36 + + ### Set TMPDIR as recommended + setenv TMPDIR /glade/scratch/$USER/temp + mkdir -p $TMPDIR + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh + + ### Run the executable + mpiexec_mpt ./wrf.exe + +If you named this script run_wrf_ctsm.csh, submit the job like this:: + + qsub run_wrf_ctsm.csh + + diff --git a/doc/source/tech_note/Crop_Irrigation/CLM50_Tech_Note_Crop_Irrigation.rst b/doc/source/tech_note/Crop_Irrigation/CLM50_Tech_Note_Crop_Irrigation.rst index 6fb9da4c55..a0a0778e45 100644 --- a/doc/source/tech_note/Crop_Irrigation/CLM50_Tech_Note_Crop_Irrigation.rst +++ b/doc/source/tech_note/Crop_Irrigation/CLM50_Tech_Note_Crop_Irrigation.rst @@ -1,12 +1,12 @@ .. _rst_Crops and Irrigation: Crops and Irrigation -======================== +==================== .. _Summary of CLM5.0 updates relative to the CLM4.5: Summary of CLM5.0 updates relative to the CLM4.5 ------------------------------------------------------ +------------------------------------------------ We describe here the complete crop and irrigation parameterizations that appear in CLM5.0. Corresponding information for CLM4.5 appeared in the @@ -42,7 +42,7 @@ These updates appear in detail in the sections below. Many also appear in Available new features since the CLM5 release -^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Addition of bioenergy crops @@ -51,10 +51,10 @@ Available new features since the CLM5 release .. _The crop model: The crop model: cash and bioenergy crops -------------------- +---------------------------------------- Introduction -^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^ Groups developing Earth System Models generally account for the human footprint on the landscape in simulations of historical and future @@ -93,7 +93,7 @@ phenology, and allocation, as well as fertilizer and irrigation management. .. _Crop plant functional types: Crop plant functional types -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^^^^^^^^^^^^^^^^ To allow crops to coexist with natural vegetation in a grid cell, the vegetated land unit is separated into a naturally vegetated land unit and @@ -230,7 +230,7 @@ managed crop types that are using the same parameter set. .. _Phenology: Phenology -^^^^^^^^^^^^^^^^ +^^^^^^^^^ CLM5-BGC includes evergreen, seasonally deciduous (responding to changes in day length), and stress deciduous (responding to changes in @@ -246,7 +246,7 @@ maturity and harvest. .. _Planting: Planting -''''''''''''''''' +'''''''' All crops must meet the following requirements between the minimum planting date and the maximum planting date (for the northern hemisphere) in :numref:`Table Crop phenology parameters`: @@ -318,7 +318,7 @@ the range for that day. :math:`{T}_{f}` is the freezing temperature of water and .. _Leaf emergence: Leaf emergence -''''''''''''''''''''''' +'''''''''''''' According to AgroIBIS, leaves may emerge when the growing degree-days of soil temperature to 0.05 m depth (:math:`GDD_{T_{soi} }` ), which is tracked since planting, @@ -335,7 +335,7 @@ the carbon allocation algorithm in section :numref:`Leaf emergence to grain fill .. _Grain fill: Grain fill -''''''''''''''''''' +'''''''''' The grain fill phase (phase 3) begins in one of two ways. The first potential trigger is based on temperature, similar to phase 2. A variable tracked since planting, similar to :math:`GDD_{T_{soi} }` but for 2-m air temperature, @@ -352,7 +352,7 @@ leaf longevity for the pft as done in the BGC part of the model. .. _Harvest: Harvest -'''''''''''''''' +''''''' Harvest is assumed to occur as soon as the crop reaches maturity. When :math:`GDD_{T_{{\rm 2m}} }` reaches 100% of :math:`{GDD}_{mat}` or @@ -407,7 +407,7 @@ fcur is the fraction of allocation that goes to currently displayed growth. .. _Allocation: Allocation -^^^^^^^^^^^^^^^^^ +^^^^^^^^^^ Allocation changes based on the crop phenology phases phenology (section :numref:`Phenology`). Simulated C assimilation begins every year upon leaf emergence in phase @@ -447,8 +447,8 @@ respiration had not taken place. .. _Leaf emergence to grain fill: -Leaf emergence -''''''''''''''''''''''''''''''''''''' +Leaf emergence +'''''''''''''' During phase 2, the allocation coefficients (fraction of available C) to each C pool are defined as: @@ -467,8 +467,8 @@ exclusively to the fine roots. .. _Grain fill to harvest: -Grain fill -'''''''''''''''''''''''''''''' +Grain fill +'''''''''' The calculation of :math:`a_{froot}` remains the same from phase 2 to phase 3. During grain fill (phase 3), other allocation coefficients change to: @@ -497,7 +497,7 @@ coefficients (:numref:`Table Crop allocation parameters`). .. _Nitrogen retranslocation for crops: Nitrogen retranslocation for crops -'''''''''''''''''''''''''''''''''''''' +'''''''''''''''''''''''''''''''''' Nitrogen retranslocation in crops occurs when nitrogen that was used for tissue growth of leaves, stems, and fine roots during the early growth @@ -551,7 +551,7 @@ fulfill plant nitrogen demands. .. _Harvest to food and seed: Harvest -'''''''''''''''''''''''''''''' +''''''' Variables track the flow of grain C and N to food and of all other plant pools, including live stem C and N, to litter, and to biofuel feedstock. A fraction (determined by the :math:`biofuel\_harvfrac`, defined in @@ -712,12 +712,12 @@ the target C:N ratios used during the leaf emergence phase (phase 2). .. _Other Features: Other Features -^^^^^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^^^ .. _Physical Crop Characteristics: Physical Crop Characteristics -'''''''''''''''''''''''''''''' +''''''''''''''''''''''''''''' Leaf area index (*L*) is calculated as a function of specific leaf area (SLA, :numref:`Table Crop phenology parameters`) and leaf C. Stem area index (*S*) is equal to 0.1\ *L* for temperate and tropical corn, sugarcane, switchgrass, and miscanthus and 0.2\ *L* for @@ -742,8 +742,8 @@ and :math:`L_{\max }` is the maximum leaf area index (:numref:`Table Crop alloca .. _Interactive fertilization: -Interactive Fertilization -'''''''''''''''''''''''''''''' +Interactive Fertilization +''''''''''''''''''''''''' CLM simulates fertilization by adding nitrogen directly to the soil mineral nitrogen pool to meet crop nitrogen demands using both industrial fertilizer and manure application. CLM’s separate crop land unit ensures that natural vegetation will not access the fertilizer applied to crops. @@ -790,7 +790,7 @@ the counter is reached. .. _Biological nitrogen fixation for soybeans: Biological nitrogen fixation for soybeans -'''''''''''''''''''''''''''''''''''''''''' +''''''''''''''''''''''''''''''''''''''''' Biological N fixation for soybeans is calculated by the fixation and uptake of nitrogen module (Chapter :numref:`rst_FUN`) and is the same as N fixation in natural vegetation. Unlike natural vegetation, where a fraction of each pft are N fixers, all soybeans @@ -798,8 +798,8 @@ are treated as N fixers. .. _Latitude vary base tempereature for growing degree days: -Latitudinal variation in base growth tempereature -'''''''''''''''''''''''''''''''''''''''''''''''''''''''' +Latitudinal variation in base growth tempereature +''''''''''''''''''''''''''''''''''''''''''''''''' For most crops, :math:`GDD_{T_{{\rm 2m}} }` (growing degree days since planting) is the same in all locations. However, the for both rainfed and irrigated spring wheat and sugarcane, the calculation of @@ -822,7 +822,7 @@ and sugarcane. .. _Separate reproductive pool: Separate reproductive pool -'''''''''''''''''''''''''''''' +'''''''''''''''''''''''''' One notable difference between natural vegetation and crops is the presence of reproductive carbon and nitrogen pools. Accounting for the reproductive pools helps determine whether crops are performing @@ -839,7 +839,7 @@ nitrogen are available for grain development. .. _The irrigation model: The irrigation model -------------------------- +-------------------- The CLM includes the option to irrigate cropland areas that are equipped for irrigation. The application of irrigation responds dynamically to diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt new file mode 100644 index 0000000000..89ae531242 --- /dev/null +++ b/lilac/CMakeLists.txt @@ -0,0 +1,215 @@ +cmake_minimum_required(VERSION 2.8.12.1) + +##include("/glade/work/negins/UFSCOMP/cime/tools/Macros.cmake") + +set (CIME_ROOT "/glade/work/negins/UFSCOMP/cime") +message ("CIME_ROOT: ${CIME_ROOT}") + +set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + + +set (CIME_CMAKE_MODULE_DIRECTORY "/glade/work/negins/UFSCOMP/cime/src/CMake/") +message ("CIME_CMAKE_MODULE_DIRECTORY: ${CIME_CMAKE_MODULE_DIRECTORY}") + + +list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + +set (MACRO_ROOT "/glade/work/negins/UFSCOMP/cime/tools/") +include(${MACRO_ROOT}/Macros.cmake) + +list(APPEND CMAKE_MODULE_PATH ${MACRO_ROOT}) +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + + +set (CLM_ROOT "/glade/work/negins/UFSCOMP/components/clm") + +message("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~") + +include_directories (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/genf90_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/Sourcelist_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/pFUnit_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/FindpFUnit.cmake) + + +#include (Macros.cmake) +#include(CIME_initial_setup) + +message("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~") + +### ------------------------------------------------------------- + +# project name +project(LILAC Fortran C) +enable_language(Fortran) + + +# This definition is needed to avoid having ESMF depend on mpi +add_definitions(-DHIDE_MPI) + + +message("----------------------------------------------------") +message ("CMAKE_CURRENT_SOURCE_DIR: ${CMAKE_CURRENT_SOURCE_DIR}") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +message("----------------------------------------------------") + + + +message("----------------------------------------------------") +# Add source directories from other share code (csm_share, etc.). This should be +# done first, so that in case of name collisions, the CLM versions take +# precedence (when there are two files with the same name, the one added later +# wins). +add_subdirectory(${CIME_ROOT}/src/share/util csm_share) +add_subdirectory(${CIME_ROOT}/src/share/unit_test_stubs/util csm_share_stubs) +add_subdirectory(${CIME_ROOT}/src/share/esmf_wrf_timemgr esmf_wrf_timemgr) +add_subdirectory(${CIME_ROOT}/src/drivers/mct/shr drv_share) +message("----------------------------------------------------") + +# Extract just the files we need from drv_share +set (drv_sources_needed_base + glc_elevclass_mod.F90 + ) +extract_sources("${drv_sources_needed_base}" "${drv_sources}" drv_sources_needed) + +message("~~~~~~~~~~~~~~~~~~~~~~CLM_ROOT~~~~~~~~~~~~~~~~~~~~~~") +# Add CLM source directories (these add their own test directories) +add_subdirectory(${CLM_ROOT}/src/utils clm_utils) +add_subdirectory(${CLM_ROOT}/src/biogeochem clm_biogeochem) +add_subdirectory(${CLM_ROOT}/src/soilbiogeochem clm_soilbiogeochem) +add_subdirectory(${CLM_ROOT}/src/biogeophys clm_biogeophys) +add_subdirectory(${CLM_ROOT}/src/dyn_subgrid clm_dyn_subgrid) +add_subdirectory(${CLM_ROOT}/src/main clm_main) +add_subdirectory(${CLM_ROOT}/src/init_interp clm_init_interp) +add_subdirectory(${CLM_ROOT}/src/fates/main fates_main) + +# Add general unit test directories (stubbed out files, etc.) +add_subdirectory(unit_test_stubs) +add_subdirectory(unit_test_shr) + + +# Remove shr_mpi_mod from share_sources. +# This is needed because we want to use the mock shr_mpi_mod in place of the real one +# +# TODO: this should be moved into a general-purpose function in Sourcelist_utils. +# Then this block of code could be replaced with a single call, like: +# remove_source_file(${share_sources} "shr_mpi_mod.F90")} + +foreach (sourcefile ${share_sources}) + string(REGEX MATCH "shr_mpi_mod.F90" match_found ${sourcefile}) + if(match_found) + list(REMOVE_ITEM share_sources ${sourcefile}) + endif() +endforeach() + + +# We rely on pio for cmake utilities like findnetcdf.cmake, so that we don't +# need to duplicate this cmake code +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +list (APPEND CMAKE_MODULE_PATH "${CIME_ROOT}/src/externals/pio2/cmake") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + + +add_subdirectory (${CIME_ROOT}/src/externals/pio2/test) + +message("----------------------------------------------------") +option(ENABLE_PFUNIT "Enable pfUnit testing Framework" ON) +if (ENABLE_PFUNIT) + find_package(pfUnit) + include(pfUnit_utils) + include_directories("${PFUNIT_INCLUDE_DIRS}") +endif (ENABLE_PFUNIT) +message("----------------------------------------------------") + + +find_package(MPI REQUIRED) +# TODO: This should be found from the find_package call but its not working +#set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") +find_package(ESMF REQUIRED) + + +message("------------include (CIME_utils)--------------------") +include(CIME_utils) +message("----------------------------------------------------") + +find_package(NetCDF COMPONENTS C Fortran) +include_directories(${NetCDF_C_INCLUDE_DIRS} ${NetCDF_Fortran_INCLUDE_DIRS}) +message("NetCDF_C_INCLUDE_DIRS: ${NetCDF_C_INCLUDE_DIRS}") +message("----------------------------------------------------") + +##=======## +#set(CESM_ROOT "/glade/work/negins/UFSCOMP/") +#set(CSM_SHR "/glade/work/negins/UFSCOMP/components/clm/src/unit_test_stubs/csm_share/") + +#add_subdirectory(${CESM_ROOT}/models/csm_share/shr csm_share) +#add_subdirectory(${CSM_SHR} ) + +message("----------------------------------------------------") + + + +# -lclm libclm.a +SET(NAMES libclm.a) + +#find_library(LIB_TO_INCLUDE +# libclm.a +# PATHS /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) +#find_library(LIB_TO_INCLUDE /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) + +#message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") +#include_directories(${LIB_TO_INCLUDE}) +#link_directories(${LIB_TO_INCLUDE}) +#message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") +#find_library(LIB_TO_INCLUDE /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) +#message(STATUS "include_directories: ${LIB_TO_INCLUDE}") +#target_link_libraries (${LIB_TO_INCLUDE}) + + +# Local CMake modules + +if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + set(dialect "-ffree-form -std=f2008 -fimplicit-none") + set(bounds "-fbounds-check") +endif() +if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + set(dialect "-stand f08 -free -implicitnone") + set(bounds "-check bounds") +endif() +if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI") + set(dialect "-Mfreeform -Mdclchk -Mstandard -Mallocatable=03") + set(bounds "-C") +endif() + +set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds}") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") + +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") + + +message(STATUS "==============================================================") +message(STATUS "Fortran Compiler : ${CMAKE_Fortran_COMPILER}") +message(STATUS "cmake Fortran Flags : ${CMAKE_Fortran_FLAGS}") +message(STATUS "==============================================================") +message(STATUS "==============================================================") + + +#add_executable("lilac.exe" ../lilac/*.F90) + +# +# Compile. +# + +file(GLOB_RECURSE SOURCES lilac/*.F90) +#add_subdirectory(lilac) +#add_executable(${PROJECT_NAME}.exe ../lilac/demo_driver.F90 +# ../lilac/lilac_mod.F90 ../lilac/atmos_cap.F90 ../lilac/lilac_utils.F90 +# ../lilac/lnd_cap.F90 ../lilac/cpl_mod.F90) + +add_executable (${PROJECT_NAME}.exe ${SOURCES}) +target_link_libraries(${PROJECT_NAME}.exe ${LIB_TO_INCLUDE}) + +#add_subdirectory(lilac) +#add_subdirectory(tests) diff --git a/lilac/Dockerfile b/lilac/Dockerfile new file mode 100644 index 0000000000..cdd4200a64 --- /dev/null +++ b/lilac/Dockerfile @@ -0,0 +1,26 @@ +FROM jhamman/esmf:latest +LABEL description="LILAC development environment" + +RUN yum install -y curl +RUN yum upgrade -y +RUN yum update -y +RUN yum clean all +RUN yum -y install wget bzip2 + +WORKDIR /usr/src/lilac/ + +RUN mkdir -p external +RUN mkdir -p ci + +COPY external/pfunit external/pfunit +COPY ci/* ci/ + +# Install some remaining dependencies +ENV PATH /usr/local/miniconda/bin:$PATH +RUN ./ci/install_python.sh + +ENV ESMF_CONFIG_FILE /usr/local/lib/esmf.mk + +# Install PFUNIT +RUN ./ci/install_pfunit.sh +ENV PFUNIT_INSTALL /usr/pfunit diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile new file mode 100644 index 0000000000..8a50eedb0b --- /dev/null +++ b/lilac/atm_driver/Makefile @@ -0,0 +1,45 @@ +#================================================================================ +# Makefile to compile atm_driver on cheyenne +#================================================================================ + +#================================================================================ +# NOTE: Before running this, you must: +# +# (1) Run cime's configure tool in order to generate a Macros.make file +# +# (2) Source the .env_mach_specific.sh file created by the configure +# tool in order to set up the environment correctly. +# +# (3) Set the environment variable CTSM_MKFILE - e.g. +# +# export CTSM_MKFILE=/glade/scratch/sacks/test_lilac_1205a/bld/ctsm.mk +# +#================================================================================ + +include Macros.make + +include $(CTSM_MKFILE) + +.SUFFIXES: .F90 + +%.o : %.F90 + $(MPIFC) -c $(CTSM_INCLUDES) $(FFLAGS) $< + +atm_driver.o : $(CURDIR)/atm_driver.F90 + $(MPIFC) -c $(CTSM_INCLUDES) $(FFLAGS) $< + +atm_driver: atm_driver.o + $(MPIFC) -o $@ $^ $(LDFLAGS) $(CTSM_LIBS) + mv atm_driver atm_driver.exe + +# module dependencies: +atm_driver.o: + +.PHONY: clean berzerk remake +clean: + rm -f *.exe *.o *.mod *.optr* +berzerk: + rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe +remake: + rm lilac_mod.o atm_driver.o atm_driver.exe & make + diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 new file mode 100644 index 0000000000..a1dcfad487 --- /dev/null +++ b/lilac/atm_driver/atm_driver.F90 @@ -0,0 +1,654 @@ +program atm_driver + + !---------------------------------------------------------------------------- + ! This is a driver for running lilac with CTSM + ! There can be no references to ESMF in the driver (the host atmosphere cannot + ! be required to know or use ESMF) + ! + ! hierarchy seen here: + ! + ! atm driver* (WRF, atm_driver, ...) + ! | + ! | + ! lilac (not an ESMF gridded component!) + ! | |________________________.____________.......... gridded components + ! | | | + ! ESMF lilac_atmcap ESMF CTSM cap ESMF river cap (Mizzouroute, Mosart) + !---------------------------------------------------------------------------- + + use netcdf , only : nf90_open, nf90_create, nf90_enddef, nf90_close + use netcdf , only : nf90_clobber, nf90_write, nf90_nowrite, nf90_noerr, nf90_double + use netcdf , only : nf90_def_dim, nf90_def_var, nf90_put_att, nf90_put_var + use netcdf , only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var + use lilac_mod , only : lilac_init1, lilac_init2, lilac_run, lilac_final + use lilac_constants , only : fillvalue => lilac_constants_fillvalue + use ctsm_LilacCouplingFieldIndices + use ctsm_LilacCouplingFields, only : lilac_atm2lnd, lilac_lnd2atm + ! A real atmosphere should not use l2a_fields directly. We use it here just for + ! convenience of writing every lnd -> atm field to a diagnostic output file. + use ctsm_LilacCouplingFields, only : l2a_fields + + use shr_cal_mod , only : shr_cal_date2ymd + use shr_sys_mod , only : shr_sys_abort + + implicit none +#include + + integer :: comp_comm + integer :: ierr + real , allocatable :: centerCoords(:,:) + real*8 , allocatable :: atm_lons(:), atm_lats(:) + integer , allocatable :: atm_global_index(:) + integer :: mytask, ntasks + logical :: masterproc + integer :: my_start, my_end + integer :: i_local, i_global + integer :: nlocal, nglobal + integer :: g,i,k ! indices + integer :: fileunit ! for namelist input + integer :: nstep ! time step counter + integer :: atm_nsteps ! number of time steps of the simulation + integer :: nsteps_prev_segs ! number of steps run in previous run segments + integer :: atm_nsteps_all_segs ! number of time steps of the simulation, across all run segments (see comment below about atm_ndays_all_segs) + character(len=512) :: restart_file ! local path to lilac restart filename + integer :: idfile, varid + integer :: atm_restart_ymd + integer :: atm_restart_year, atm_restart_mon + integer :: atm_restart_day, atm_restart_secs + + ! Namelist and related variables + character(len=512) :: caseid + character(len=512) :: atm_mesh_file + integer :: atm_global_nx + integer :: atm_global_ny + character(len=128) :: atm_calendar + integer :: atm_timestep + integer :: atm_start_year ! (yyyy) + integer :: atm_stop_year ! (yyyy) + integer :: atm_start_mon ! (mm) + integer :: atm_stop_mon ! (mm) + integer :: atm_start_day + integer :: atm_stop_day + integer :: atm_start_secs + integer :: atm_stop_secs + character(len=32) :: atm_starttype + ! atm_ndays_all_segs is used for generating the fake data. This should give the total + ! number of days that will be run across all restart segments. If this isn't exactly + ! right, it's not a big deal: it just means that the fake data won't be symmetrical in + ! time. It's just important that we have some rough measure of the run length for the + ! generation of temporal variability, and that this measure be independent of the + ! number of restart segments that the run is broken into (so that we can get the same + ! answers in a restart run as in a straight-through run). + integer :: atm_ndays_all_segs + + namelist /atm_driver_input/ caseid, atm_mesh_file, atm_global_nx, atm_global_ny, & + atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, atm_starttype, & + atm_ndays_all_segs + !------------------------------------------------------------------------ + + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + call MPI_init(ierr) + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + comp_comm = MPI_COMM_WORLD + call MPI_COMM_RANK(comp_comm, mytask, ierr) + call MPI_COMM_SIZE(comp_comm, ntasks, ierr) + if (mytask == 0) then + masterproc = .true. + else + masterproc = .false. + end if + + if (masterproc ) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + !----------------------------------------------------------------------------- + ! Read in namelist file ... + !----------------------------------------------------------------------------- + + if (masterproc) then + print *,"---------------------------------------" + print *, "MPI initialized in atm_driver ..." + end if + + ! The following will read this on all processors - might want to do a read just on the + ! master processor and broadcast in the future + + open(newunit=fileunit, status="old", file="atm_driver_in") + read(fileunit, atm_driver_input, iostat=ierr) + if (ierr > 0) then + print *, 'Error on reading atm_driver_in' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + close(fileunit) + + !----------------------------------------------------------------------------- + ! Read mesh file to get number of points (n_points) + ! Also read in global number of lons and lats (needed for lilac history output) + !----------------------------------------------------------------------------- + + call read_netcdf_mesh(atm_mesh_file, nglobal) + if (atm_global_nx * atm_global_ny /= nglobal) then + print *, " atm global nx, ny, nglobal = ",atm_global_nx, atm_global_ny, nglobal + call shr_sys_abort("Error atm_nx*atm_ny is not equal to nglobal") + end if + if (masterproc ) then + print *, " atm_driver mesh file ",trim(atm_mesh_file) + print *, " atm global nx = ",atm_global_nx + print *, " atm global nx = ",atm_global_ny + print *, " atm number of global points in mesh is:", nglobal + end if + + !----------------------------------------------------------------------------- + ! atmosphere domain decomposition + ! + ! Note that other code in this module relies on this simple decomposition, where we + ! assign the first points to task 0, then the next points to task 1, etc. Specifically, + ! code in write_lilac_to_atm_driver_fields relies on this decomposition. + !----------------------------------------------------------------------------- + + nlocal = nglobal / ntasks + + my_start = nlocal*mytask + min(mytask, mod(nglobal, ntasks)) + 1 + ! The first mod(nglobal,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(nglobal, ntasks)) then + nlocal = nlocal + 1 + end if + my_end = my_start + nlocal - 1 + + allocate(atm_global_index(nlocal)) + + i_global = my_start + do i_local = 1, nlocal + atm_global_index(i_local) = i_global + i_global = i_global + 1 + end do + + ! first determine lats and lons + allocate(atm_lons(nlocal)) + allocate(atm_lats(nlocal)) + do i = 1,nlocal + i_global = atm_global_index(i) + atm_lons(i) = centerCoords(1,i_global) + atm_lats(i) = centerCoords(2,i_global) + end do + + !------------------------------------------------------------------------ + ! Initialize lilac + !------------------------------------------------------------------------ + + if (masterproc ) then + print *, " initializing lilac with start type ",trim(atm_starttype) + end if + call lilac_init1() + call lilac_init2( & + mpicom = comp_comm, & + atm_global_index = atm_global_index, & + atm_lons = atm_lons, & + atm_lats = atm_lats, & + atm_global_nx = atm_global_nx, & + atm_global_ny = atm_global_ny, & + atm_calendar = atm_calendar, & + atm_timestep = atm_timestep, & + atm_start_year = atm_start_year, & + atm_start_mon = atm_start_mon, & + atm_start_day = atm_start_day, & + atm_start_secs = atm_start_secs, & + starttype_in = atm_starttype, & + fields_needed_from_data = [ & + ! Deliberately excluding bcphidry to test the logic that says that a field should + ! only be read from data if explicitly requested by the host atmosphere. + lilac_a2l_Faxa_bcphodry, lilac_a2l_Faxa_bcphiwet, & + lilac_a2l_Faxa_ocphidry, lilac_a2l_Faxa_ocphodry, lilac_a2l_Faxa_ocphiwet, & + lilac_a2l_Faxa_dstwet1, lilac_a2l_Faxa_dstdry1, & + lilac_a2l_Faxa_dstwet2, lilac_a2l_Faxa_dstdry2, & + lilac_a2l_Faxa_dstwet3, lilac_a2l_Faxa_dstdry3, & + lilac_a2l_Faxa_dstwet4, lilac_a2l_Faxa_dstdry4]) + + !------------------------------------------------------------------------ + ! Run lilac + !------------------------------------------------------------------------ + + ! Assume that will always run for N days (no partial days) + + if (atm_starttype == 'startup') then + + if ( atm_stop_year /= atm_start_year) then + call shr_sys_abort('not supporting start and stop years to be different') + else if (atm_stop_mon /= atm_start_mon) then + call shr_sys_abort('not supporting start and stop months to be different') + else if (atm_stop_secs /= 0 .or. atm_start_secs /= 0) then + call shr_sys_abort('not supporting start and stop secs to be nonzero') + else + atm_nsteps = ((atm_stop_day - atm_start_day) * 86400.) / atm_timestep + end if + nsteps_prev_segs = 0 + + else ! continue + + open(newunit=fileunit, file='rpointer.lilac', form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) call shr_sys_abort('Error opening rpointer.lilac') + read(fileunit,'(a)', iostat=ierr) restart_file + if (ierr < 0) call shr_sys_abort('Error reading rpointer.lilac') + close(fileunit) + if (masterproc) then + print *,'lilac restart_file = ',trim(restart_file) + end if + + ierr = nf90_open(restart_file, NF90_NOWRITE, idfile) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_open') + + ierr = nf90_inq_varid(idfile, 'curr_ymd', varid) + if (ierr /= nf90_NoErr) call shr_sys_abort('ERROR: nf90_inq_varid curr_ymd') + ierr = nf90_get_var(idfile, varid, atm_restart_ymd) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_ymd') + + ierr = nf90_inq_varid(idfile, 'curr_tod', varid) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_inq_varid curr_tod') + ierr = nf90_get_var(idfile, varid, atm_restart_secs) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_tod') + + ierr = nf90_close(idfile) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close') + + if (masterproc) then + print *,'restart_ymd = ',atm_restart_ymd + end if + call shr_cal_date2ymd(atm_restart_ymd, atm_restart_year, atm_restart_mon, atm_restart_day) + + if ( atm_stop_year /= atm_restart_year .or. atm_restart_year /= atm_start_year) then + write(6,*)'atm_stop_year, atm_restart_year, atm_start_year = ',& + atm_stop_year, atm_restart_year, atm_start_year + call shr_sys_abort('not supporting restart, stop and start years to be different') + else if (atm_stop_mon /= atm_restart_mon .or. atm_restart_mon /= atm_start_mon) then + write(6,*)'atm_stop_mon, atm_restart_mon, atm_start_mon = ',& + atm_stop_mon, atm_restart_mon, atm_start_mon + call shr_sys_abort('not supporting restart, stop and start months to be different') + else if (atm_stop_secs /= 0 .or. atm_restart_secs /= 0 .or. atm_start_secs /= 0) then + write(6,*)'atm_stop_secs, atm_restart_secs, atm_start_secs = ',& + atm_stop_secs, atm_restart_secs, atm_start_secs + call shr_sys_abort('not supporting restart, stop or start secs to be nonzero') + else + atm_nsteps = ((atm_stop_day - atm_restart_day) * 86400.) / atm_timestep + ! The following calculation of nsteps_prev_segs is why we need to check the start + ! time in the above error checks. + nsteps_prev_segs = ((atm_restart_day - atm_start_day) * 86400.) / atm_timestep + end if + + end if + + atm_nsteps_all_segs = atm_ndays_all_segs * (86400 / atm_timestep) + + do nstep = 1,atm_nsteps + ! fill in the dataptr in lilac_coupling_fields + call atm_driver_to_lilac (atm_lons, atm_lats, nstep, nsteps_prev_segs, atm_nsteps_all_segs) + + if (nstep == atm_nsteps) then + call lilac_run(write_restarts_now=.true., stop_now=.true.) + else + call lilac_run(write_restarts_now=.false., stop_now=.false.) + end if + end do + + call write_lilac_to_atm_driver_fields( & + caseid = caseid, & + nlocal = nlocal, & + atm_global_nx = atm_global_nx, & + atm_global_ny = atm_global_ny, & + ntasks = ntasks, & + masterproc = masterproc) + + !------------------------------------------------------------------------ + ! Finalize lilac + !------------------------------------------------------------------------ + + call lilac_final( ) + + if (masterproc ) then + print *, "=======================================" + print *, " ............. DONE ..................." + print *, "=======================================" + end if + + call MPI_finalize(ierr) + +!======================================================= +contains +!======================================================= + + subroutine read_netcdf_mesh(filename, nglobal) + + ! input/output variables + character(*) , intent(in) :: filename + integer , intent(out) :: nglobal + + ! local Variables + integer :: idfile + integer :: ierr + integer :: dimid_elem + integer :: dimid_coordDim + integer :: iddim_elem + integer :: iddim_coordDim + integer :: idvar_CenterCoords + integer :: nelem + integer :: coordDim + character (len=100) :: string + !----------------------------------------------------------------------------- + + ! Open mesh file and get the idfile + ierr = nf90_open(filename, NF90_NOWRITE, idfile) + call nc_check_err(ierr, "opening file", filename) + + ! Get the dimid of dimensions + ierr = nf90_inq_dimid(idfile, 'elementCount', dimid_elem) + call nc_check_err(ierr, "inq_dimid elementCount", filename) + ierr = nf90_inq_dimid(idfile, 'coordDim', dimid_coordDim) + call nc_check_err(ierr, "coordDim", filename) + + ! Inquire dimensions based on their dimeid(s) + ierr = nf90_inquire_dimension(idfile, dimid_elem, string, nelem) + call nc_check_err(ierr, "inq_dim elementCount", filename) + ierr = nf90_inquire_dimension(idfile, dimid_coordDim, string, coordDim) + call nc_check_err(ierr, "inq_dim coordDim", filename) + + if (masterproc ) then + print *, "=======================================" + print *, "number of elements is : ", nelem + print *, "coordDim is :", coordDim + print *, "=======================================" + end if + + ! Get coordinate values + allocate (centerCoords(coordDim, nelem)) + + ierr = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords) + call nc_check_err(ierr, "inq_varid centerCoords", filename) + ierr = nf90_get_var(idfile, idvar_CenterCoords, centerCoords, start=(/1,1/), count=(/coordDim, nelem/)) + call nc_check_err(ierr,"get_var CenterCoords", filename) + + ! Close the file + ierr = nf90_close(idfile) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close') + + nglobal = nelem + + end subroutine read_netcdf_mesh + + !======================================================================== + subroutine nc_check_err(ierror, description, filename) + use netcdf + integer , intent(in) :: ierror + character(*), intent(in) :: description + character(*), intent(in) :: filename + + if (ierror /= nf90_noerr) then + write (*,'(6a)') 'ERROR ', trim(description),'. NetCDF file : "', trim(filename),& + '". Error message:', nf90_strerror(ierror) + endif + end subroutine nc_check_err + + !======================================================================== + subroutine atm_driver_to_lilac (lon, lat, nstep, nsteps_prev_segs, atm_nsteps_all_segs) + + ! input/output variables + real*8, intent(in) :: lon(:) + real*8, intent(in) :: lat(:) + integer, intent(in) :: nstep ! current step number + integer, intent(in) :: nsteps_prev_segs ! number of time steps in previous run segments + integer, intent(in) :: atm_nsteps_all_segs ! total number of steps in simulation + + ! local variables + integer :: lsize + real*8 :: time_midpoint + real*8 :: time_perturbation + real*8, allocatable :: space_perturbation(:) + real*8, allocatable :: space_time_perturbation(:) + real*8, allocatable :: data(:) + integer :: i + integer :: i_local + ! -------------------------------------------------------- + + lsize = size(lon) + allocate(space_perturbation(lsize)) + allocate(space_time_perturbation(lsize)) + allocate(data(lsize)) + + ! The time perturbation will range from about -0.5 to 0.5 + time_midpoint = atm_nsteps_all_segs / 2.d0 + time_perturbation = 0.5d0 * ((nstep + nsteps_prev_segs) - time_midpoint)/time_midpoint + space_perturbation(:) = lat(:)*0.01d0 + lon(:)*0.01d0 + space_time_perturbation(:) = time_perturbation + space_perturbation(:) + + ! Only set landfrac in the first time step, similar to what most real atmospheres + ! will probably do. + ! + ! We don't have a good way to set a land mask / fraction in this demo driver. Since it + ! is okay for the atmosphere to call a point ocean when CTSM calls it land, but not + ! the reverse, here we call all points ocean. In a real atmosphere, the atmosphere + ! should set landfrac to > 0 for any point for which it needs land input, to ensure + ! that CTSM is running over all of the necessary points. Note that this landfrac + ! variable doesn't actually impact the running of CTSM, but it is used for + ! consistency checking. + if (nstep == 1) then + data(:) = 0.d0 + call lilac_atm2lnd(lilac_a2l_Sa_landfrac, data) + end if + + ! In the following, try to have each field have different values, in order to catch + ! mis-matches (e.g., if foo and bar were accidentally swapped in CTSM, we couldn't + ! catch that if they both had the same value). + + ! Sa_z is allowed to be time-constant, but we're keeping it time-varying here in + ! order to test the ability to have an allowed-to-be-time-constant field actually be + ! time-varying. + data(:) = 30.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Sa_z, data) + + ! Use a time-constant topo field (which may be typical of atmospheres), in order to + ! test the infrastructure that allows fields to be just set once, in the first time + ! step. + if (nstep == 1) then + data(:) = 10.0d0 + space_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Sa_topo, data) + end if + + data(:) = 20.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Sa_u, data) + + data(:) = 40.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Sa_v, data) + + data(:) = 280.1d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Sa_ptem, data) + + data(:) = 100100.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Sa_pbot, data) + + data(:) = 280.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Sa_tbot, data) + + data(:) = 0.0004d0 + space_time_perturbation(:)*1.0d-8 + call lilac_atm2lnd(lilac_a2l_Sa_shum, data) + + data(:) = 200.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Faxa_lwdn, data) + + data(:) = 1.0d-8 + space_time_perturbation(:)*1.0d-9 + call lilac_atm2lnd(lilac_a2l_Faxa_rainc, data) + + data(:) = 2.0d-8 + space_time_perturbation(:)*1.0d-9 + call lilac_atm2lnd(lilac_a2l_Faxa_rainl, data) + + data(:) = 1.0d-9 + space_time_perturbation(:)*1.0d-10 + call lilac_atm2lnd(lilac_a2l_Faxa_snowc, data) + + data(:) = 2.0d-9 + space_time_perturbation(:)*1.0d-10 + call lilac_atm2lnd(lilac_a2l_Faxa_snowl, data) + + data(:) = 100.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Faxa_swndr, data) + + data(:) = 50.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Faxa_swvdr, data) + + data(:) = 25.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Faxa_swndf, data) + + data(:) = 45.0d0 + space_time_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Faxa_swvdf, data) + + ! This field has the potential to be read from data. We're setting it here to provide + ! a test of the logic that says that a field should only be read from data if + ! explicitly requested by the host atmosphere. + data(:) = 1.0d-13 + space_time_perturbation(:)*1.0d-14 + call lilac_atm2lnd(lilac_a2l_Faxa_bcphidry, data) + + end subroutine atm_driver_to_lilac + + !======================================================================== + subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, & + atm_global_ny, ntasks, masterproc) + + ! Fetch lnd2atm fields from LILAC and write them out. + ! + ! This should only be called once, at the end of the run. (Calling it multiple times + ! will lead to the output file being overwritten.) + + ! input/output variables + character(len=*), intent(in) :: caseid + integer, intent(in) :: nlocal + integer, intent(in) :: atm_global_nx + integer, intent(in) :: atm_global_ny + integer, intent(in) :: ntasks + logical, intent(in) :: masterproc + + ! local variables + integer :: nfields + integer :: ierr + integer :: ncid + integer :: dimid_x + integer :: dimid_y + integer :: nglobal + integer :: i + integer, allocatable :: varids(:) + character(len=:), allocatable :: field_name + integer, allocatable :: counts(:) + integer, allocatable :: displacements(:) + real*8, allocatable :: data(:) + real*8, allocatable :: data_global(:) + real*8, allocatable :: data_2d(:,:) + + ! -------------------------------------------- + + ! Implementation note: for convenience and ease of maintenance, we directly leverage + ! l2a_fields in this subroutine, and loop through all available indices in that + ! list. A real atmosphere should not use that variable directly; instead, it should + ! use the indices defined in ctsm_LilacCouplingFieldIndices, similarly to what is done + ! above in atm_driver_to_lilac. + + nfields = l2a_fields%num_fields() + + ! ------------------------------------------------------------------------ + ! Set up output file + ! ------------------------------------------------------------------------ + + if (masterproc) then + ! Use an arbitrary time rather than trying to figure out the correct time stamp. This + ! works because this subroutine is only called once, at the end of the run + ierr = nf90_create(trim(caseid)//'.clm2.lilac_atm_driver_h0.0001-01.nc', nf90_clobber, ncid) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_create atm driver output file') + + ierr = nf90_def_dim(ncid, 'atm_nx', atm_global_nx, dimid_x) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_dim nx atm driver output file') + ierr = nf90_def_dim(ncid, 'atm_ny', atm_global_ny, dimid_y) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_dim ny atm driver output file') + + allocate(varids(nfields)) + do i = 1, nfields + field_name = l2a_fields%get_fieldname(i) + ierr = nf90_def_var(ncid, field_name, nf90_double, [dimid_x, dimid_y], varids(i)) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_var atm driver output file: '//trim(field_name)) + ierr = nf90_put_att(ncid, varids(i), '_FillValue', fillvalue) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_put_att atm driver output file: '//trim(field_name)) + end do + + ierr = nf90_enddef(ncid) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_enddef atm driver output file') + end if + + ! ------------------------------------------------------------------------ + ! Determine number of points on each processor and set up arrays needed for gathering + ! data to master proc + ! ------------------------------------------------------------------------ + + allocate(data(nlocal)) + nglobal = atm_global_nx * atm_global_ny + if (masterproc) then + allocate(counts(ntasks)) + allocate(displacements(ntasks)) + allocate(data_global(nglobal)) + allocate(data_2d(atm_global_nx, atm_global_ny)) + else + allocate(counts(1)) + allocate(displacements(1)) + allocate(data_global(1)) + end if + + call mpi_gather(nlocal, 1, mpi_int, counts, 1, mpi_int, 0, mpi_comm_world, ierr) + if (ierr .ne. MPI_SUCCESS) then + call shr_sys_abort(' ERROR in mpi_gather for counts') + end if + + if (masterproc) then + displacements(1) = 0 + do i = 2, ntasks + displacements(i) = displacements(i-1) + counts(i-1) + end do + end if + + ! ------------------------------------------------------------------------ + ! Retrieve data for each field, gather to master and write to file + ! ------------------------------------------------------------------------ + + do i = 1, nfields + field_name = l2a_fields%get_fieldname(i) + ! See implementation note above: typically a host atmosphere should NOT loop + ! through fields, accessing them anonymously by index as is done here. Instead, + ! typically the host atmosphere would access specific fields using the indices + ! defined in ctsm_LilacCouplingFieldIndices. + call lilac_lnd2atm(i, data) + + ! Because of the way we set up the decomposition, we can use a simple mpi_gatherv + ! without needing to worry about any rearrangement, and points will appear in the + ! correct order on the master proc. Specifically, we rely on the fact that the + ! first points are assigned to task 0, then the next points to task 1, etc. + call mpi_gatherv(data, size(data), mpi_double, data_global, counts, displacements, & + mpi_double, 0, mpi_comm_world, ierr) + if (ierr .ne. MPI_SUCCESS) then + call shr_sys_abort(' ERROR in mpi_gatherv for ' // trim(field_name)) + end if + + if (masterproc) then + data_2d = reshape(data_global, [atm_global_nx, atm_global_ny]) + ierr = nf90_put_var(ncid, varids(i), data_2d) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_put_var atm driver output file: '//trim(field_name)) + end if + end do + + if (masterproc) then + ierr = nf90_close(ncid) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close atm driver output file') + end if + + end subroutine write_lilac_to_atm_driver_fields + +end program diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in new file mode 100644 index 0000000000..8391f41a34 --- /dev/null +++ b/lilac/atm_driver/atm_driver_in @@ -0,0 +1,18 @@ +&atm_driver_input + caseid = 'FILL_THIS_IN' + atm_mesh_file = 'FILL_THIS_IN' + atm_global_nx = FILL_THIS_IN + atm_global_ny = FILL_THIS_IN + atm_timestep = 1800 + atm_calendar = 'NOLEAP' + atm_start_year = 2000 + atm_stop_year = 2000 + atm_start_mon = 1 + atm_stop_mon = 1 + atm_start_secs = 0 + atm_stop_secs = 0 + atm_start_day = 1 + atm_stop_day = FILL_THIS_IN + atm_starttype = 'startup' + atm_ndays_all_segs = FILL_THIS_IN +/ diff --git a/lilac/atm_driver/cheyenne.sub b/lilac/atm_driver/cheyenne.sub new file mode 100644 index 0000000000..4733e8ae3e --- /dev/null +++ b/lilac/atm_driver/cheyenne.sub @@ -0,0 +1,39 @@ +#!/bin/tcsh +#PBS -N job_name +#PBS -A P93300606 +#PBS -l walltime=00:10:00 +#PBS -q premium +##PBS -q share +##PBS -q regular +#PBS -j oe + +#PBS -l select=2:ncpus=4:mpiprocs=8 +##PBS -l select=1:ncpus=1:mpiprocs=2 +##PBS -l select=1:ncpus=1:mpiprocs=1 + +#ml ??? + +### Set TMPDIR as recommended +setenv TMPDIR /glade/scratch/$USER +mkdir -p $TMPDIR + +echo "hello" +### Run the executable +set MPI_SHEPHERD=true + +source /glade/u/apps/ch/opt/lmod/7.5.3/lmod/lmod/init/csh +module purge +module load ncarenv/1.2 intel/19.0.2 esmf_libs mkl mpt/2.19 netcdf-mpi/4.6.1 pnetcdf/1.11.0 ncarcompilers/0.4.1 +setenv OMP_STACKSIZE 256M +setenv MPI_TYPE_DEPTH 16 +setenv MPI_IB_CONGESTED 1 +setenv MPI_USE_ARRAY None +setenv ESMFMKFILE /glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default/esmf.mk +setenv ESMF_RUNTIME_PROFILE ON +setenv ESMF_RUNTIME_PROFILE_OUTPUT SUMMARY +setenv UGCSINPUTPATH /glade/work/turuncu/FV3GFS/benchmark-inputs/2012010100/gfs/fcst +setenv UGCSFIXEDFILEPATH /glade/work/turuncu/FV3GFS/fix_am +setenv UGCSADDONPATH /glade/work/turuncu/FV3GFS/addon +#setenv MPI_USE_ARRAY false + +mpiexec_mpt -p "%g:" ./atm_driver.exe diff --git a/lilac/bld_templates/config_compilers_template.xml b/lilac/bld_templates/config_compilers_template.xml new file mode 100644 index 0000000000..9fc3358408 --- /dev/null +++ b/lilac/bld_templates/config_compilers_template.xml @@ -0,0 +1,44 @@ + + + + + + + + + + $GPTL_CPPDEFS + + + $NETCDF_PATH + + + $PIO_FILESYSTEM_HINTS + + + $PNETCDF_PATH + + $ESMF_LIBDIR + + + $EXTRA_CFLAGS + + + + $EXTRA_FFLAGS + + + + + diff --git a/lilac/bld_templates/config_machines_template.xml b/lilac/bld_templates/config_machines_template.xml new file mode 100644 index 0000000000..a197e02dfa --- /dev/null +++ b/lilac/bld_templates/config_machines_template.xml @@ -0,0 +1,115 @@ + + + + + + + + + Temporary build information for a CTSM build + + + $OS + + + $COMPILER + + + mpich + + + $CIME_OUTPUT_ROOT + + + $$CIME_OUTPUT_ROOT/inputdata + + + $$CIME_OUTPUT_ROOT/inputdata + + + $$CIME_OUTPUT_ROOT/archive/$$CASE + + + $GMAKE + + + $GMAKE_J + + + none + + + CTSM + + + $MAX_MPITASKS_PER_NODE + + + $MAX_MPITASKS_PER_NODE + + + + + mpirun + + + -np $$TOTALPES + -prepend-rank + + + + + + + + diff --git a/lilac/bld_templates/ctsm_template.cfg b/lilac/bld_templates/ctsm_template.cfg new file mode 100644 index 0000000000..7351b5da71 --- /dev/null +++ b/lilac/bld_templates/ctsm_template.cfg @@ -0,0 +1,82 @@ +[buildnml_input] + +# ------------------------------------------------------------------------ +# Paths to resolution-dependent files +# +# Values with FILL_THIS_IN *must* be specified. Values with UNSET should +# generally be specified explicitly, but it's also acceptable to leave +# these as UNSET and use the out-of-the-box defaults. +# +# Note that some other files also need to be set in lilac_in: +# atm_mesh_filename and lnd_mesh_filename +# ------------------------------------------------------------------------ + +# CTSM's domain file +lnd_domain_file = FILL_THIS_IN + +# CTSM's surface dataset +fsurdat = FILL_THIS_IN + +# The finidat (initial conditions) file does not absolutely need to be +# specified, but in most cases, you should specify your own finidat file +# rather than using one of the out-of-the-box ones. +finidat = UNSET + +# ------------------------------------------------------------------------ +# High-level configuration options +# ------------------------------------------------------------------------ + +# ctsm_phys: 'clm4_5' or 'clm5_0' +ctsm_phys = clm5_0 + +# configuration: 'nwp' or 'clm' +# +# This controls a number of physics options that differ between the +# standard numerical weather prediction (nwp) and climate (clm) +# configurations of CTSM. These are typically options that are +# computationally expensive. These include plant hydraulic stress and +# the MEGAN chemistry model (both of which are on by default for clm but +# off by default for nwp). +configuration = nwp + +# structure: 'fast' or 'standard' +# +# This controls various aspects of CTSM's subgrid and vertical layer +# structure. Typically, 'fast' is used for high-resolution NWP +# applications and 'standard' is used for lower-resolution climate +# applications. Parameters changed by this variable include number of +# soil and snow layers and how much subgrid variability is allowed in +# each grid cell. This also controls the maximum number of iterations in +# some iterative solution schemes - again, trading off speed for +# accuracy. +structure = fast + +# bgc_mode: +# - 'sp' (satellite phenology - no biogeochemistry) +# - 'bgc' (full biogeochemistry) +# - 'cn' (CLM4-style biogeochemistry) +# - 'fates' (Functionally Assembled Terrestrial Ecosystem Simulator) +bgc_mode = sp + +# crop: 'off' or 'on' ('on' only allowed for bgc_mode = 'bgc' or 'cn') +crop = off + +# vichydro: 'off' or 'on' ('on' only allowed for bgc_mode = 'sp') +vichydro = off + +# ------------------------------------------------------------------------ +# Specific configuration options +# ------------------------------------------------------------------------ + +co2_ppmv = 367.0 +use_case = 2000_control +lnd_tuning_mode = clm5_0_GSWP3v1 + +# spinup: whether to do accelerated spinup: 'off' or 'on' +spinup = off + +# ------------------------------------------------------------------------ +# Inputdata location (filled in automatically for your given build directory, but can be changed if desired) +# ------------------------------------------------------------------------ + +inputdata_path = $INPUTDATA diff --git a/lilac/bld_templates/lilac_in_template b/lilac/bld_templates/lilac_in_template new file mode 100644 index 0000000000..78a8ab75cf --- /dev/null +++ b/lilac/bld_templates/lilac_in_template @@ -0,0 +1,53 @@ +&lilac_run_input + caseid = 'ctsm_lilac' + create_esmf_pet_files = .false. +/ +&lilac_history_input + lilac_histfreq_option = 'never' + lilac_histfreq_n = 1 +/ +&lilac_atmcap_input + atm_mesh_filename = 'FILL_THIS_IN' +/ +&lilac_lnd_input + lnd_mesh_filename = 'FILL_THIS_IN' +/ +&atmaero_stream + stream_fldfilename='$INPUTDATA/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' + stream_year_first = 2000 + stream_year_last = 2000 +/ +&pio_default_inparm + pio_async_interface = .false. + pio_blocksize = -1 + pio_buffer_size_limit = -1 + pio_debug_level = 0 + pio_rearr_comm_enable_hs_comp2io = .true. + pio_rearr_comm_enable_hs_io2comp = .false. + pio_rearr_comm_enable_isend_comp2io = .false. + pio_rearr_comm_enable_isend_io2comp = .true. + pio_rearr_comm_fcd = "2denable" + pio_rearr_comm_max_pend_req_comp2io = -2 + pio_rearr_comm_max_pend_req_io2comp = 64 + pio_rearr_comm_type = "p2p" +/ +&papi_inparm + papi_ctr1_str = "PAPI_FP_OPS" + papi_ctr2_str = "PAPI_NO_CTR" + papi_ctr3_str = "PAPI_NO_CTR" + papi_ctr4_str = "PAPI_NO_CTR" +/ +&prof_inparm + profile_add_detail = .false. + profile_barrier = .false. + profile_depth_limit = 4 + profile_detail_limit = 2 + profile_disable = .false. + profile_global_stats = .true. + profile_outpe_num = 1 + profile_outpe_stride = 0 + profile_ovhd_measurement = .false. + profile_papi_enable = .false. + profile_single_file = .false. + profile_timer = 4 +/ diff --git a/lilac/bld_templates/lnd_modelio_template.nml b/lilac/bld_templates/lnd_modelio_template.nml new file mode 100644 index 0000000000..6ee97fb119 --- /dev/null +++ b/lilac/bld_templates/lnd_modelio_template.nml @@ -0,0 +1,8 @@ +&pio_inparm + pio_netcdf_format = "64bit_offset" + pio_numiotasks = -99 + pio_rearranger = 1 + pio_root = 1 + pio_stride = $PIO_STRIDE + pio_typename = "$PIO_TYPENAME" +/ diff --git a/lilac/bld_templates/mosart_in b/lilac/bld_templates/mosart_in new file mode 100644 index 0000000000..833e4f10f8 --- /dev/null +++ b/lilac/bld_templates/mosart_in @@ -0,0 +1,21 @@ +&mosart_inparm + bypass_routing_option = "direct_in_place" + decomp_option = "roundrobin" + delt_mosart = 1800 + do_rtm = .true. + do_rtmflood = .false. + finidat_rtm = " " + frivinp_rtm = "/glade/p/cesmdata/cseg/inputdata/rof/mosart/MOSART_routing_Global_0.5x0.5_c170601.nc" + ice_runoff = .true. + qgwl_runoff_option = "threshold" + rtmhist_fexcl1 = "" + rtmhist_fexcl2 = "" + rtmhist_fexcl3 = "" + rtmhist_fincl1 = "" + rtmhist_fincl2 = "" + rtmhist_fincl3 = "" + rtmhist_mfilt = 1 + rtmhist_ndens = 1 + rtmhist_nhtfrq = 0 + smat_option = "Xonly" +/ diff --git a/lilac/build_ctsm b/lilac/build_ctsm new file mode 100755 index 0000000000..b460f9b011 --- /dev/null +++ b/lilac/build_ctsm @@ -0,0 +1,19 @@ +#!/usr/bin/env python3 +"""Script to build CTSM library and its dependencies using cime's build system""" + +import os +import sys + +_CTSM_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__)), + os.pardir, + 'python') +sys.path.insert(1, _CTSM_PYTHON) + +from ctsm.path_utils import add_cime_lib_to_path + +cime_path = add_cime_lib_to_path() + +from ctsm.lilac_build_ctsm import main + +if __name__ == "__main__": + main(cime_path=cime_path) diff --git a/lilac/ci/build_and_test_lilac.sh b/lilac/ci/build_and_test_lilac.sh new file mode 100755 index 0000000000..6ed3c17e6e --- /dev/null +++ b/lilac/ci/build_and_test_lilac.sh @@ -0,0 +1,23 @@ +#!/usr/bin/env bash + +set -e +set -x + +echo "building lilac" + +# build lilac +mkdir -p /lilac/build + +export CMAKE_PREFIX_PATH=/usr/lib64/mpich/bin + +cd /lilac/build && cmake -D CMAKE_BUILD_TYPE=DEBUG .. +make VERBOSE=1 # -j 4 + +echo "done building lilac, time to run the tests..." + +# run test suite +ctest + +# run system tests +# TODO: these should probably be run via ctest +/lilac/build/tests/rand_atm_rand_lnd/rand_atm_rand_lnd \ No newline at end of file diff --git a/lilac/ci/code_format.sh b/lilac/ci/code_format.sh new file mode 100755 index 0000000000..828b0e229a --- /dev/null +++ b/lilac/ci/code_format.sh @@ -0,0 +1,11 @@ +#!/usr/bin/env bash + +# Run emacs/list on all Fortran source files +format_fortran () { + echo "Parsing $1 as language Fortran" + emacs --batch -l ./emacs-fortran-formating-script.lisp \ + -f f90-batch-indent-region $1 +} +export -f format_fortran +find ../lilac/ -iregex ".*\.F[0-9]*" -exec bash -c 'format_fortran "$0"' {} \; +find ../tests/ -iregex ".*\.F[0-9]*" -exec bash -c 'format_fortran "$0"' {} \; diff --git a/lilac/ci/emacs-fortran-formating-script.lisp b/lilac/ci/emacs-fortran-formating-script.lisp new file mode 100644 index 0000000000..99ed3f3981 --- /dev/null +++ b/lilac/ci/emacs-fortran-formating-script.lisp @@ -0,0 +1,46 @@ +(defun f90-batch-indent-region () + "Run `f90-batch-beatify-region' on the specified filename. +Use this from the command line, with `-batch'; +it won't work in an interactive Emacs. +For example, invoke \"emacs -batch -l ~/.emacs-batch-f90-indent -f f90-batch-indent-region file.f\"" + (if (not noninteractive) + (error "`f90-batch-indent-region' is to be used only with -batch")) + (let ((make-backup-files nil) + (version-control nil) + (auto-save-default nil) + (find-file-run-dired nil) + (kept-old-versions 259259) + (kept-new-versions 259259)) + (let ((error 0) + file + (files ())) + (while command-line-args-left + (setq file (expand-file-name (car command-line-args-left))) + (cond ((not (file-exists-p file)) + (message ">> %s does not exist!" file) + (setq error 1 + command-line-args-left (cdr command-line-args-left))) + ((file-directory-p file) + (setq command-line-args-left + (nconc (directory-files file) + (cdr command-line-args-left)))) + (t + (setq files (cons file files) + command-line-args-left (cdr command-line-args-left))))) + (while files + (setq file (car files) + files (cdr files)) + (condition-case err + (progn + (if buffer-file-name (kill-buffer (current-buffer))) + (find-file file) + (buffer-disable-undo (current-buffer)) + (set-buffer-modified-p nil) + (f90-mode) + (message (file-name-nondirectory buffer-file-name)) + ; compute indentation of first + ; line + (f90-indent-subprogram) + (f90-downcase-keywords) + (save-buffer) +)))))) diff --git a/lilac/ci/environment.yml b/lilac/ci/environment.yml new file mode 100644 index 0000000000..735c333293 --- /dev/null +++ b/lilac/ci/environment.yml @@ -0,0 +1,5 @@ +channels: + - conda-forge +dependencies: + - python=3.6 + - cmake>=3 diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh new file mode 100755 index 0000000000..bbd21faddb --- /dev/null +++ b/lilac/ci/install_esmf.sh @@ -0,0 +1,23 @@ +#!/usr/bin/env bash +set -e +set -x + +cd ./external/esmf + +export FC="mpif90" + +export ESMF_DIR=$PWD +export ESMF_COMM="mpich3" +export ESMF_COMPILER="gfortran" +export ESMF_INSTALL_PREFIX="/usr/local" +export ESMF_INSTALL_LIBDIR="/usr/local/lib" +export ESMF_INSTALL_MODDIR="/usr/local/mod" +export ESMF_INSTALL_BINDIR="/usr/local/bin" +export ESMF_INSTALL_DOCDIR="/usr/local/doc" +export ESMFMKFILE="${ESMF_INSTALL_LIBDIR}/esmf.mk" + +make -j4 lib +make install +# make install check + +cd - \ No newline at end of file diff --git a/lilac/ci/install_pfunit.sh b/lilac/ci/install_pfunit.sh new file mode 100755 index 0000000000..9290ab7306 --- /dev/null +++ b/lilac/ci/install_pfunit.sh @@ -0,0 +1,17 @@ +#!/usr/bin/env bash + +set -e +set -x + +cd ./external/pfunit + +# set environemnt variables +export F90=gfortran +export F90_VENDOR=GNU + +mkdir -p build +cd build +cmake .. +make install INSTALL_DIR=/usr/pfunit + +cd - diff --git a/lilac/ci/install_python.sh b/lilac/ci/install_python.sh new file mode 100755 index 0000000000..02a15e043c --- /dev/null +++ b/lilac/ci/install_python.sh @@ -0,0 +1,14 @@ +#!/usr/bin/env bash + +set -e +set -x + +# Install miniconda +wget --quiet http://repo.continuum.io/miniconda/Miniconda3-latest-Linux-x86_64.sh -O /usr/src/miniconda.sh +bash /usr/src/miniconda.sh -b -p /usr/local/miniconda +conda update conda --yes +conda clean -tipy +conda config --set always_yes yes --set changeps1 no +conda --version + +conda install -c conda-forge cmake>=3 diff --git a/lilac/cmake/CMakeModules/FindESMF.cmake b/lilac/cmake/CMakeModules/FindESMF.cmake new file mode 100644 index 0000000000..943ffd6087 --- /dev/null +++ b/lilac/cmake/CMakeModules/FindESMF.cmake @@ -0,0 +1,52 @@ +# +# Author: Ali Samii - The University of Texas at Austin +# +# Distributed under GPL2. For more info refer to: +# https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html +# +# +# FindESMF +# -------- +# +# This script tries to find the ESMF library. You have to define +# the path to esmf.mk file in your installation directory. +# +# There are plans to extend this script to find ESMF automatically, +# but until then, you should set the environment variable +# +# ESMF_CONFIG_FILE = /path/to/esmf.mk +# +# in your installation directory. The output will be +# +# ESMF_LINK_LINE : All the libraries and link line stuff +# ESMF_COMPILER_LINE : All the compiler flags and include dirs +# +# + +# Defining the ${Esc} for syntax coloring. +string(ASCII 27 Esc) + +message ("Parsing ESMF_CONFIG_FILE: " $ENV{ESMF_CONFIG_FILE}) + +file(STRINGS "$ENV{ESMF_CONFIG_FILE}" all_vars) +foreach(str ${all_vars}) + string(REGEX MATCH "^[^#]" def ${str}) + if (def) + string(REGEX MATCH "^[^=]+" var_name ${str}) + string(REGEX MATCH "=(.+)$" var_def ${str}) + set(var_def ${CMAKE_MATCH_1}) + set(${var_name} ${var_def}) + mark_as_advanced (${var_name}) + endif() +endforeach() + +set (ESMF_LINK_LINE "${ESMF_F90LINKOPTS} \ + ${ESMF_F90LINKRPATHS} \ + ${ESMF_F90LINKPATHS} \ + ${ESMF_F90ESMFLINKLIBS}") + +set (ESMF_COMPILER_LINE "${ESMF_F90COMPILEOPTS} \ + ${ESMF_F90COMPILEPATHS} \ + ${ESMF_F90COMPILEFREENOCPP} \ + ${ESMF_CXXCOMPILEPATHS}") + diff --git a/lilac/docker-compose.yml b/lilac/docker-compose.yml new file mode 100644 index 0000000000..8bd538f458 --- /dev/null +++ b/lilac/docker-compose.yml @@ -0,0 +1,9 @@ +version: '3' + +services: + lilac: + build: . + container_name: lilac + volumes: + - .:/lilac + command: /lilac/ci/build_and_test_lilac.sh diff --git a/lilac/docs/Makefile b/lilac/docs/Makefile new file mode 100644 index 0000000000..0e382f9883 --- /dev/null +++ b/lilac/docs/Makefile @@ -0,0 +1,20 @@ +# Minimal makefile for Sphinx documentation +# + +# You can set these variables from the command line. +SPHINXOPTS = +SPHINXBUILD = sphinx-build +SPHINXPROJ = lilac +SOURCEDIR = . +BUILDDIR = _build + +# Put it first so that "make" without argument is like "make help". +help: + @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) + +.PHONY: help Makefile + +# Catch-all target: route all unknown targets to Sphinx using the new +# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). +%: Makefile + @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) \ No newline at end of file diff --git a/lilac/docs/api.rst b/lilac/docs/api.rst new file mode 100644 index 0000000000..dac6446ce8 --- /dev/null +++ b/lilac/docs/api.rst @@ -0,0 +1,20 @@ +LILAC API +========= + +LILAC provides a high-level API (in Fortran) for coupling to CTSM. +LILAC was built using the assumption that the Atmosphere model +component in each LILAC application would opperate as the "driver". + +The atmosphere component will need to call each of the following subroutines: + + * `lilac_init` + * `lilac_run` + * `lilac_final` + +LILAC Core +---------- +.. f:autosrcfile:: core.f90 + +ESMF Utils +---------- +.. f:autosrcfile:: esmf_utils.f90 diff --git a/lilac/docs/conf.py b/lilac/docs/conf.py new file mode 100644 index 0000000000..f8c67d5d2b --- /dev/null +++ b/lilac/docs/conf.py @@ -0,0 +1,187 @@ +# -*- coding: utf-8 -*- +# +# Configuration file for the Sphinx documentation builder. +# +# This file does only contain a selection of the most common options. For a +# full list see the documentation: +# http://www.sphinx-doc.org/en/stable/config + +# -- Path setup -------------------------------------------------------------- + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. +# +import os +# import sys +# sys.path.insert(0, os.path.abspath('.')) + + +# -- Project information ----------------------------------------------------- + +project = 'lilac' +copyright = '2018, Joseph Hamman' +author = 'Joseph Hamman' + +# The short X.Y version +version = '' +# The full version, including alpha/beta/rc tags +release = '' + + +# -- General configuration --------------------------------------------------- + +# If your documentation needs a minimal Sphinx version, state it here. +# +# needs_sphinx = '1.0' + +# Add any Sphinx extension module names here, as strings. They can be +# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom +# ones. +extensions = [ + 'sphinx.ext.autodoc', + 'sphinx.ext.todo', + 'sphinx.ext.coverage', + 'sphinx.ext.imgmath', + 'sphinx.ext.ifconfig', + 'sphinx.ext.intersphinx', + 'sphinxfortran.fortran_domain', + 'sphinxfortran.fortran_autodoc', +] + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# The suffix(es) of source filenames. +# You can specify multiple suffix as a list of string: +# +# source_suffix = ['.rst', '.md'] +source_suffix = '.rst' +fortran_src = '*f90' + +# The master toctree document. +master_doc = 'index' + +# The language for content autogenerated by Sphinx. Refer to documentation +# for a list of supported languages. +# +# This is also used if you do content translation via gettext catalogs. +# Usually you set "language" from the command line for these cases. +language = None + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +# This pattern also affects html_static_path and html_extra_path . +exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] + +# The name of the Pygments (syntax highlighting) style to use. +pygments_style = 'sphinx' + + +# -- Options for HTML output ------------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +# +html_theme = 'alabaster' + +# Theme options are theme-specific and customize the look and feel of a theme +# further. For a list of options available for each theme, see the +# documentation. +# +# html_theme_options = {} + +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +html_static_path = ['_static'] + +# Custom sidebar templates, must be a dictionary that maps document names +# to template names. +# +# The default sidebars (for documents that don't match any pattern) are +# defined by theme itself. Builtin themes are using these templates by +# default: ``['localtoc.html', 'relations.html', 'sourcelink.html', +# 'searchbox.html']``. +# +# html_sidebars = {} + + +# -- Options for HTMLHelp output --------------------------------------------- + +# Output file base name for HTML help builder. +htmlhelp_basename = 'lilacdoc' + + +# -- Options for LaTeX output ------------------------------------------------ + +latex_elements = { + # The paper size ('letterpaper' or 'a4paper'). + # + # 'papersize': 'letterpaper', + + # The font size ('10pt', '11pt' or '12pt'). + # + # 'pointsize': '10pt', + + # Additional stuff for the LaTeX preamble. + # + # 'preamble': '', + + # Latex figure (float) alignment + # + # 'figure_align': 'htbp', +} + +# Grouping the document tree into LaTeX files. List of tuples +# (source start file, target name, title, +# author, documentclass [howto, manual, or own class]). +latex_documents = [ + (master_doc, 'lilac.tex', 'lilac Documentation', + 'Joseph Hamman', 'manual'), +] + + +# -- Options for manual page output ------------------------------------------ + +# One entry per manual page. List of tuples +# (source start file, name, description, authors, manual section). +man_pages = [ + (master_doc, 'lilac', 'lilac Documentation', + [author], 1) +] + + +# -- Options for Texinfo output ---------------------------------------------- + +# Grouping the document tree into Texinfo files. List of tuples +# (source start file, target name, title, author, +# dir menu entry, description, category) +texinfo_documents = [ + (master_doc, 'lilac', 'lilac Documentation', + author, 'lilac', 'One line description of project.', + 'Miscellaneous'), +] + + +# -- Extension configuration ------------------------------------------------- + +# -- Options for intersphinx extension --------------------------------------- + +# Example configuration for intersphinx: refer to the Python standard library. +intersphinx_mapping = {'https://docs.python.org/': None} + + +## -- Options for Sphinx-Fortran --------------------------------------------- +# List of possible extensions in the case of a directory listing +fortran_ext = ['f90', 'F90', 'f95', 'F95'] + +# This variable must be set with file pattern, like "*.f90", or a list of them. +# It is also possible to specify a directory name; in this case, all files than +# have an extension matching those define by the config variable `fortran_ext` +# are used. +fortran_src = [os.path.abspath('../lilac/')] + +# Indentation string or length (default 4). If it is an integer, +# indicates the number of spaces. +fortran_indent = 4 diff --git a/lilac/docs/developers.rst b/lilac/docs/developers.rst new file mode 100644 index 0000000000..f4910d80d6 --- /dev/null +++ b/lilac/docs/developers.rst @@ -0,0 +1,28 @@ +Developers Guide to Using LILAC +=============================== + +Building LILAC +-------------- + +LILAC can be build using CMake:: + + $ cd /lilac/build && cmake .. + $ make + +For development and testing purposes, LILAC can also be built using a +`docker-compose` script:: + + $ docker-compose build + $ docker-compose run + +Testing LILAC +------------- + +LILAC includes a full test suite including unit tests and a number of +simplified coupled model tests. To run these tests, simply run the `ctest` +command:: + + $ ctest + +Note, if you are using the docker-compose development, the `docker-compose run` +command will build and run LILAC automatically. diff --git a/lilac/docs/index.rst b/lilac/docs/index.rst new file mode 100644 index 0000000000..e7c7a097f7 --- /dev/null +++ b/lilac/docs/index.rst @@ -0,0 +1,16 @@ +LILAC: Lightweight Infrastructure for Land Atmosphere Coupling +============================================================== + +LILAC is a new coupling interface for the Community Terrestrial Systems Model +(CTSM). It provides a high-level Fortran API for coupling CTSM to atmospheric +models such as the Weather Research and Forecast (WRF) model. LILAC makes +extensive use of the Earth System Modeling Framework (ESMF). + +.. toctree:: + :maxdepth: 2 + :caption: Contents: + +Contents +--------------- +* :doc:`developers` +* :doc:`api` diff --git a/lilac/docs/requirements.txt b/lilac/docs/requirements.txt new file mode 100644 index 0000000000..f3d707325c --- /dev/null +++ b/lilac/docs/requirements.txt @@ -0,0 +1,3 @@ +numpy +sphinx-fortran +sphinx==1.6.7 \ No newline at end of file diff --git a/lilac/download_input_data b/lilac/download_input_data new file mode 100755 index 0000000000..056467bce8 --- /dev/null +++ b/lilac/download_input_data @@ -0,0 +1,17 @@ +#!/usr/bin/env python3 +"""Download input data for running CTSM via LILAC""" + +import os +import sys + +_CTSM_PYTHON = os.path.join(os.path.dirname(os.path.realpath(__file__)), + os.pardir, + 'python') +sys.path.insert(1, _CTSM_PYTHON) + +from ctsm import add_cime_to_path + +from ctsm.lilac_download_input_data import main + +if __name__ == "__main__": + main() diff --git a/lilac/make_runtime_inputs b/lilac/make_runtime_inputs new file mode 100755 index 0000000000..61e06f6adc --- /dev/null +++ b/lilac/make_runtime_inputs @@ -0,0 +1,19 @@ +#!/usr/bin/env python3 +"""CTSM namelist creator""" + +import os +import sys + +_CTSM_PYTHON = os.path.join(os.path.dirname(os.path.realpath(__file__)), + os.pardir, + 'python') +sys.path.insert(1, _CTSM_PYTHON) + +from ctsm.path_utils import add_cime_lib_to_path + +cime_path = add_cime_lib_to_path() + +from ctsm.lilac_make_runtime_inputs import main + +if __name__ == "__main__": + main(cime_path=cime_path) diff --git a/lilac/src/.gitignore b/lilac/src/.gitignore new file mode 100644 index 0000000000..d52decad68 --- /dev/null +++ b/lilac/src/.gitignore @@ -0,0 +1,5 @@ +*.o +job_name* +PET* +*.exe +batch.sub diff --git a/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 b/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 new file mode 100644 index 0000000000..b18c376f98 --- /dev/null +++ b/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 @@ -0,0 +1,514 @@ +module ctsm_LilacAtm2LndFieldListType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines a class and related methods for a list of lilac fields sent from atm -> lnd. + ! + ! (Note: this is very similar to LilacLnd2AtmFieldListType. However, between the fact + ! that (1) they have different sets of supported methods, and (2) the use of the + ! dynamic vector, it seemed to make more sense to have totally separate classes rather + ! than trying to share code between the two.) + ! + ! To set up this list (lilac_atm2lnd_field_list_type): + ! + ! - Initialize it by calling the 'init' method + ! + ! - Add variables with add_var + ! + ! - When done adding variables, call complete_setup + ! - Note that you cannot access or perform any operations on any of the fields until + ! this is done! + ! + ! - Set which fields are needed from data with set_needed_from_data + ! + ! To use this list (after complete_setup has been called), here is the workflow: + ! + ! - Query number of fields with num_fields + ! + ! - Set fields each time step with set_field + ! + ! - After fields are set, check that all required fields have been set by calling check_all_set + ! + ! - At the end of each time step, call reset_provided + ! + ! !USES: + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : OOBMsg => shr_log_OOBMsg + use shr_sys_mod , only : shr_sys_abort + use lilac_constants, only : field_index_unset, logunit + + implicit none + private + + ! !PRIVATE TYPES: + + type, private :: lilac_atm2lnd_field_type + private + + ! Metadata set initially in initialization + character(len=:), allocatable :: fieldname + character(len=:), allocatable :: units + logical :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + logical :: can_be_time_const ! if true, it's okay for this field to be set just once, in the first time step, keeping its same value for the entire run (e.g., a landfrac field that doesn't vary in time) + + ! Metadata set later in initialization + logical :: needed_from_data ! whether the host atmosphere wants LILAC to read this field from data + logical :: required_by_lnd ! whether this field is actually required by the land + + ! Data set each time step + real(r8), pointer :: dataptr(:) + logical :: provided_this_time ! whether this variable has been set this time step + logical :: provided_ever ! whether this variable has ever been set + end type lilac_atm2lnd_field_type + + ! Define a dynamic vector for lilac_atm2lnd_field_type +#define VECTOR_NAME lilac_atm2lnd_field_vector +#define TYPE_NAME type(lilac_atm2lnd_field_type) +#define THROW(string) call shr_sys_abort(string) +#include "dynamic_vector_typedef.inc" + + ! + ! !PUBLIC TYPES: + type, public :: lilac_atm2lnd_field_list_type + private + type(lilac_atm2lnd_field_vector) :: field_vec + type(lilac_atm2lnd_field_type), allocatable :: fields(:) + contains + ! Methods for setting up the list: + procedure, public :: init + procedure, public :: add_var + procedure, public :: complete_setup + + ! Methods to query or set data: + procedure, public :: num_fields ! return the number of fields + procedure, public :: set_needed_from_data ! dictate that the given fields need to be read from data + procedure, public :: is_needed_from_data ! query whether the given field is needed from data + procedure, public :: set_field ! set data for one field + procedure, public :: check_all_set ! check to ensure that all required fields have been set this time + procedure, public :: reset_provided ! reset the provided_this_time variable for all fields + procedure, public :: get_fieldname ! get the field name for a given field + procedure, public :: get_units ! get the units for a given field + procedure, public :: get_dataptr ! get a pointer to the data for a given field (this should be treated as read-only!) + + ! Private methods: + procedure, private :: check_field_index ! check whether a field index is valid + end type lilac_atm2lnd_field_list_type + + interface lilac_atm2lnd_field_type + module procedure new_lilac_atm2lnd_field_type + end interface lilac_atm2lnd_field_type + +contains + + ! Complete the dynamic vector definition. +#include "dynamic_vector_procdef.inc" + + !----------------------------------------------------------------------- + function new_lilac_atm2lnd_field_type(fieldname, units, available_from_data, can_be_time_const) result(this) + ! + ! !DESCRIPTION: + ! Initialize a new lilac_atm2lnd_field_type object + ! + ! !ARGUMENTS: + type(lilac_atm2lnd_field_type) :: this ! function result + character(len=*), intent(in) :: fieldname + character(len=*), intent(in) :: units + logical, intent(in) :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + logical, intent(in) :: can_be_time_const ! if true, it's okay for this field to be set just once, in the first time step, keeping its same value for the entire run (e.g., a landfrac field that doesn't vary in time) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'new_lilac_atm2lnd_field_type' + !----------------------------------------------------------------------- + + this%fieldname = fieldname + this%units = units + this%available_from_data = available_from_data + this%can_be_time_const = can_be_time_const + + ! Assume false until told otherwise + this%needed_from_data = .false. + + ! Assume true until told otherwise + this%required_by_lnd = .true. + + nullify(this%dataptr) + this%provided_this_time = .false. + this%provided_ever = .false. + + end function new_lilac_atm2lnd_field_type + + !----------------------------------------------------------------------- + subroutine init(this) + ! + ! !DESCRIPTION: + ! Initialize a new lilac_atm2lnd_field_list_type object + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'init' + !----------------------------------------------------------------------- + + this%field_vec = lilac_atm2lnd_field_vector() + + end subroutine init + + !----------------------------------------------------------------------- + subroutine add_var(this, fieldname, units, available_from_data, can_be_time_const, field_index) + ! + ! !DESCRIPTION: + ! Add the given field to this list + ! + ! Also set field_index to be the index of this field in list. For the sake of error + ! checking, field_index should be initialized to field_index_unset before the call to + ! this subroutine. + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + character(len=*), intent(in) :: fieldname + character(len=*), intent(in) :: units + logical, intent(in) :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + logical, intent(in) :: can_be_time_const ! if true, it's okay for this field to be set just once, in the first time step, keeping its same value for the entire run (e.g., a landfrac field that doesn't vary in time) + integer, intent(inout) :: field_index + ! + ! !LOCAL VARIABLES: + type(lilac_atm2lnd_field_type) :: one_field + + character(len=*), parameter :: subname = 'add_var' + !----------------------------------------------------------------------- + + if (allocated(this%fields)) then + write(logunit,*) subname//' ERROR: this%fields is already allocated.' + write(logunit,*) 'fieldname = ', trim(fieldname) + write(logunit,*) 'This is likely a sign that you are trying to add a variable' + write(logunit,*) 'after complete_setup has already been called.' + call shr_sys_abort('Attempt to call '//subname//' after complete_setup was called') + end if + + if (field_index /= field_index_unset) then + write(logunit,*) subname//' ERROR: attempt to add var with a field index that has already been set.' + write(logunit,*) 'fieldname, field_index = ', trim(fieldname), field_index + call shr_sys_abort('Attempt to add var with a field index that has already been set') + end if + + one_field = lilac_atm2lnd_field_type( & + fieldname = trim(fieldname), & + units = trim(units), & + available_from_data = available_from_data, & + can_be_time_const = can_be_time_const) + + call this%field_vec%push_back(one_field) + + field_index = this%field_vec%vsize() + end subroutine add_var + + !----------------------------------------------------------------------- + subroutine complete_setup(this, data_size) + ! + ! !DESCRIPTION: + ! Finalize the creation of this field list; this includes allocating the data arrays for each field + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + integer, intent(in) :: data_size ! number of points in each field (assumed to be the same for all fields) + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'complete_setup' + !----------------------------------------------------------------------- + + call this%field_vec%move_out(this%fields) + + do i = 1, this%num_fields() + allocate(this%fields(i)%dataptr(data_size)) + end do + + end subroutine complete_setup + + !----------------------------------------------------------------------- + function num_fields(this) + ! + ! !DESCRIPTION: + ! Return the number of fields + ! + ! !ARGUMENTS: + integer :: num_fields ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'num_fields' + !----------------------------------------------------------------------- + + if (.not. allocated(this%fields)) then + write(logunit,*) subname//' ERROR: this%fields has not yet been allocated' + write(logunit,*) 'This is likely a sign that you are trying to call num_fields' + write(logunit,*) 'before complete_setup has been called.' + call shr_sys_abort('Attempt to get number of fields before complete_setup was called') + end if + + num_fields = size(this%fields) + + end function num_fields + + !----------------------------------------------------------------------- + subroutine set_needed_from_data(this, fields_needed_from_data) + ! + ! !DESCRIPTION: + ! Dictate that the given fields need to be read from data + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + integer, intent(in) :: fields_needed_from_data(:) ! vector of field indices that need to be read from data + ! + ! !LOCAL VARIABLES: + integer :: i + integer :: field_index + + character(len=*), parameter :: subname = 'set_needed_from_data' + !----------------------------------------------------------------------- + + do i = 1, size(fields_needed_from_data) + field_index = fields_needed_from_data(i) + call this%check_field_index(field_index, subname) + + if (this%fields(field_index)%needed_from_data) then + call shr_sys_abort(subname//' attempt to set needed_from_data on field for which it has already been set: '//& + this%fields(field_index)%fieldname) + end if + + if (.not. this%fields(field_index)%available_from_data) then + call shr_sys_abort(subname//' attempt to set needed_from_data on field not available from data: '//& + this%fields(field_index)%fieldname) + end if + + this%fields(field_index)%needed_from_data = .true. + end do + + end subroutine set_needed_from_data + + !----------------------------------------------------------------------- + function is_needed_from_data(this, field_index) + ! + ! !DESCRIPTION: + ! Query whether the given field is needed from data + ! + ! !ARGUMENTS: + logical :: is_needed_from_data ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'is_needed_from_data' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + is_needed_from_data = this%fields(field_index)%needed_from_data + + end function is_needed_from_data + + !----------------------------------------------------------------------- + subroutine set_field(this, field_index, data) + ! + ! !DESCRIPTION: + ! Set data for the given field + ! + ! It is an error to try to set a field that has already been set this time + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + integer, intent(in) :: field_index + real(r8), intent(in) :: data(:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'set_field' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + if (size(data) /= size(this%fields(field_index)%dataptr)) then + call shr_sys_abort(subname//' field size mismatch for '//trim(this%fields(field_index)%fieldname)) + end if + + if (this%fields(field_index)%provided_this_time) then + ! This can typically happen in one of two ways: + ! - A component tries to re-set a field that has already been set + ! - reset_provided hasn't been called in between times + write(logunit,*) subname//' ERROR: attempt to set an already-set field: ', this%fields(field_index)%fieldname + if (this%fields(field_index)%needed_from_data) then + write(logunit,*) "This field was marked as being needed from data." + write(logunit,*) "A possible cause of this error is that it is being set by both" + write(logunit,*) "the host atmosphere and LILAC's internal data atmosphere." + end if + call shr_sys_abort(subname//' attempt to set an already-set field: '//this%fields(field_index)%fieldname) + end if + + this%fields(field_index)%dataptr(:) = data(:) + this%fields(field_index)%provided_this_time = .true. + this%fields(field_index)%provided_ever = .true. + + end subroutine set_field + + !----------------------------------------------------------------------- + subroutine check_all_set(this) + ! + ! !DESCRIPTION: + ! Check to ensure that all required fields have been set this time + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'check_all_set' + !----------------------------------------------------------------------- + + do i = 1, this%num_fields() + if (this%fields(i)%required_by_lnd) then + if (.not. this%fields(i)%provided_ever) then + call shr_sys_abort(trim(this%fields(i)%fieldname)//' required but never provided') + end if + if (.not. this%fields(i)%can_be_time_const) then + if (.not. this%fields(i)%provided_this_time) then + call shr_sys_abort(trim(this%fields(i)%fieldname)//' required but not provided this time') + end if + end if + end if + end do + + end subroutine check_all_set + + !----------------------------------------------------------------------- + subroutine reset_provided(this) + ! + ! !DESCRIPTION: + ! Reset the provided_this_time variable for all fields + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'reset_provided' + !----------------------------------------------------------------------- + + do i = 1, this%num_fields() + this%fields(i)%provided_this_time = .false. + end do + + end subroutine reset_provided + + !----------------------------------------------------------------------- + function get_fieldname(this, field_index) result(fieldname) + ! + ! !DESCRIPTION: + ! Get the field name for a given field + ! + ! (This will already be trimmed - no further trimming is needed.) + ! + ! !ARGUMENTS: + character(len=:), allocatable :: fieldname ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_fieldname' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + fieldname = this%fields(field_index)%fieldname + + end function get_fieldname + + !----------------------------------------------------------------------- + function get_units(this, field_index) result(units) + ! + ! !DESCRIPTION: + ! Get the units for a given field + ! + ! (This will already be trimmed - no further trimming is needed.) + ! + ! !ARGUMENTS: + character(len=:), allocatable :: units ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_units' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + units = this%fields(field_index)%units + + end function get_units + + !----------------------------------------------------------------------- + function get_dataptr(this, field_index) result(dataptr) + ! + ! !DESCRIPTION: + ! Get a pointer to the data for a given field + ! + ! This should be treated as read-only! Setting data should be done via the provided + ! methods in this class. + ! + ! !ARGUMENTS: + real(r8), pointer :: dataptr(:) ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_dataptr' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + dataptr => this%fields(field_index)%dataptr + + end function get_dataptr + + !----------------------------------------------------------------------- + subroutine check_field_index(this, field_index, caller) + ! + ! !DESCRIPTION: + ! Check the provided field_index for validity. If not valid, aborts. + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + character(len=*), intent(in) :: caller ! name of caller, for error messages + ! + ! !LOCAL VARIABLES: + integer :: nfields + + character(len=*), parameter :: subname = 'check_field_index' + !----------------------------------------------------------------------- + + if (field_index == field_index_unset) then + call shr_sys_abort(caller//':'//subname//' attempt to set field for unset field index') + end if + + if (field_index < 1 .or. field_index > this%num_fields()) then + write(logunit,*) caller//':'//subname//' ERROR: field_index out of bounds' + nfields = this%num_fields() + write(logunit,*) 'field_index, num_fields = ', field_index, nfields + call shr_sys_abort(caller//':'//subname//' field_index out of bounds') + end if + + end subroutine check_field_index + +end module ctsm_LilacAtm2LndFieldListType diff --git a/lilac/src/ctsm_LilacCouplingFieldIndices.F90 b/lilac/src/ctsm_LilacCouplingFieldIndices.F90 new file mode 100644 index 0000000000..c28a497a31 --- /dev/null +++ b/lilac/src/ctsm_LilacCouplingFieldIndices.F90 @@ -0,0 +1,83 @@ +module ctsm_LilacCouplingFieldIndices + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines all possible coupling field indices for coupling between atmosphere and land + ! + ! !USES: + use lilac_constants, only : field_index_unset + + implicit none + private + ! + ! !PUBLIC DATA: + + ! ------------------------------------------------------------------------ + ! These are the fields that can be passed from atm -> lnd. The host atmosphere model + ! will refer to these indices when setting fields. + ! ------------------------------------------------------------------------ + + integer, public :: lilac_a2l_Sa_landfrac = field_index_unset + integer, public :: lilac_a2l_Sa_z = field_index_unset + integer, public :: lilac_a2l_Sa_topo = field_index_unset + integer, public :: lilac_a2l_Sa_u = field_index_unset + integer, public :: lilac_a2l_Sa_v = field_index_unset + integer, public :: lilac_a2l_Sa_ptem = field_index_unset + integer, public :: lilac_a2l_Sa_pbot = field_index_unset + integer, public :: lilac_a2l_Sa_tbot = field_index_unset + integer, public :: lilac_a2l_Sa_shum = field_index_unset + integer, public :: lilac_a2l_Faxa_lwdn = field_index_unset + integer, public :: lilac_a2l_Faxa_rainc = field_index_unset + integer, public :: lilac_a2l_Faxa_rainl = field_index_unset + integer, public :: lilac_a2l_Faxa_snowc = field_index_unset + integer, public :: lilac_a2l_Faxa_snowl = field_index_unset + integer, public :: lilac_a2l_Faxa_swndr = field_index_unset + integer, public :: lilac_a2l_Faxa_swvdr = field_index_unset + integer, public :: lilac_a2l_Faxa_swndf = field_index_unset + integer, public :: lilac_a2l_Faxa_swvdf = field_index_unset + + integer, public :: lilac_a2l_Faxa_bcphidry = field_index_unset + integer, public :: lilac_a2l_Faxa_bcphodry = field_index_unset + integer, public :: lilac_a2l_Faxa_bcphiwet = field_index_unset + integer, public :: lilac_a2l_Faxa_ocphidry = field_index_unset + integer, public :: lilac_a2l_Faxa_ocphodry = field_index_unset + integer, public :: lilac_a2l_Faxa_ocphiwet = field_index_unset + integer, public :: lilac_a2l_Faxa_dstwet1 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstdry1 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstwet2 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstdry2 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstwet3 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstdry3 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstwet4 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstdry4 = field_index_unset + + ! ------------------------------------------------------------------------ + ! These are the fields that can be passed from lnd -> atm. The host atmosphere model + ! will refer to these indices when retrieving fields. + ! ------------------------------------------------------------------------ + + integer, public :: lilac_l2a_Sl_t = field_index_unset + integer, public :: lilac_l2a_Sl_tref = field_index_unset + integer, public :: lilac_l2a_Sl_qref = field_index_unset + integer, public :: lilac_l2a_Sl_avsdr = field_index_unset + integer, public :: lilac_l2a_Sl_anidr = field_index_unset + integer, public :: lilac_l2a_Sl_avsdf = field_index_unset + integer, public :: lilac_l2a_Sl_anidf = field_index_unset + integer, public :: lilac_l2a_Sl_snowh = field_index_unset + integer, public :: lilac_l2a_Sl_u10 = field_index_unset + integer, public :: lilac_l2a_Sl_fv = field_index_unset + integer, public :: lilac_l2a_Sl_ram1 = field_index_unset + integer, public :: lilac_l2a_Sl_z0m = field_index_unset + integer, public :: lilac_l2a_Fall_taux = field_index_unset + integer, public :: lilac_l2a_Fall_tauy = field_index_unset + integer, public :: lilac_l2a_Fall_lat = field_index_unset + integer, public :: lilac_l2a_Fall_sen = field_index_unset + integer, public :: lilac_l2a_Fall_lwup = field_index_unset + integer, public :: lilac_l2a_Fall_evap = field_index_unset + integer, public :: lilac_l2a_Fall_swnet = field_index_unset + integer, public :: lilac_l2a_Fall_flxdst1 = field_index_unset + integer, public :: lilac_l2a_Fall_flxdst2 = field_index_unset + integer, public :: lilac_l2a_Fall_flxdst3 = field_index_unset + integer, public :: lilac_l2a_Fall_flxdst4 = field_index_unset + +end module ctsm_LilacCouplingFieldIndices diff --git a/lilac/src/ctsm_LilacCouplingFields.F90 b/lilac/src/ctsm_LilacCouplingFields.F90 new file mode 100644 index 0000000000..29e1f7ae57 --- /dev/null +++ b/lilac/src/ctsm_LilacCouplingFields.F90 @@ -0,0 +1,295 @@ +module ctsm_LilacCouplingFields + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines the coupling fields between atmosphere and land + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use ctsm_LilacCouplingFieldIndices + use ctsm_LilacLnd2AtmFieldListType, only : lilac_lnd2atm_field_list_type + use ctsm_LilacAtm2LndFieldListType, only : lilac_atm2lnd_field_list_type + + implicit none + private + + ! + ! !PUBLIC ROUTINES: + + ! ------------------------------------------------------------------------ + ! Routines that should be called by the host atmosphere to set / get coupling fields + ! ------------------------------------------------------------------------ + + public :: lilac_atm2lnd ! Set a single atm -> lnd field + public :: lilac_lnd2atm ! Get a single lnd -> atm field + + ! ------------------------------------------------------------------------ + ! Routines that should be used internally by LILAC, *not* called directly from the host + ! atmosphere + ! ------------------------------------------------------------------------ + + public :: create_a2l_field_list + public :: create_l2a_field_list + public :: complete_a2l_field_list + public :: complete_l2a_field_list + + ! + ! !PUBLIC DATA: + + ! ------------------------------------------------------------------------ + ! These variables should only be used internally by LILAC. The host atmosphere model + ! should interact with them via the lilac_atm2lnd and lilac_lnd2atm routines. + ! ------------------------------------------------------------------------ + + type(lilac_atm2lnd_field_list_type), public :: a2l_fields + type(lilac_lnd2atm_field_list_type), public :: l2a_fields + +contains + + !----------------------------------------------------------------------- + subroutine lilac_atm2lnd(field_index, data) + ! + ! !DESCRIPTION: + ! Set a single atm -> lnd field + ! + ! field_index should be one of the lilac_a2l_* indices defined in ctsm_LilacCouplingFieldIndices + ! + ! !ARGUMENTS: + integer, intent(in) :: field_index + real(r8), intent(in) :: data(:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'lilac_atm2lnd' + !----------------------------------------------------------------------- + + call a2l_fields%set_field(field_index, data) + + end subroutine lilac_atm2lnd + + !----------------------------------------------------------------------- + subroutine lilac_lnd2atm(field_index, data) + ! + ! !DESCRIPTION: + ! Get a single lnd -> atm field + ! + ! field_index should be one of the lilac_l2a_* indices defined in ctsm_LilacCouplingFieldIndices + ! + ! !ARGUMENTS: + integer, intent(in) :: field_index + real(r8), intent(out) :: data(:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'lilac_lnd2atm' + !----------------------------------------------------------------------- + + call l2a_fields%get_field(field_index, data) + + end subroutine lilac_lnd2atm + + !----------------------------------------------------------------------- + subroutine create_a2l_field_list() + ! + ! !DESCRIPTION: + ! Create the list of fields passed from atm -> lnd. + ! + ! All of the lilac_a2l_* indices are valid after this is called. However, note that + ! a2l_fields still isn't fully usable until complete_a2l_field_list is called. + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'create_a2l_field_list' + !----------------------------------------------------------------------- + + call a2l_fields%init() + + call a2l_fields%add_var(fieldname='Sa_landfrac' , units='fraction', available_from_data=.false., & + can_be_time_const=.true., field_index=lilac_a2l_Sa_landfrac) + call a2l_fields%add_var(fieldname='Sa_z' , units='unknown', available_from_data=.false., & + can_be_time_const=.true., field_index=lilac_a2l_Sa_z) + call a2l_fields%add_var(fieldname='Sa_topo' , units='unknown', available_from_data=.false., & + can_be_time_const=.true., field_index=lilac_a2l_Sa_topo) + call a2l_fields%add_var(fieldname='Sa_u' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Sa_u) + call a2l_fields%add_var(fieldname='Sa_v' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Sa_v) + call a2l_fields%add_var(fieldname='Sa_ptem' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Sa_ptem) + call a2l_fields%add_var(fieldname='Sa_pbot' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Sa_pbot) + call a2l_fields%add_var(fieldname='Sa_tbot' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Sa_tbot) + call a2l_fields%add_var(fieldname='Sa_shum' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Sa_shum) + call a2l_fields%add_var(fieldname='Faxa_lwdn' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_lwdn) + call a2l_fields%add_var(fieldname='Faxa_rainc' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_rainc) + call a2l_fields%add_var(fieldname='Faxa_rainl' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_rainl) + call a2l_fields%add_var(fieldname='Faxa_snowc' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_snowc) + call a2l_fields%add_var(fieldname='Faxa_snowl' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_snowl) + call a2l_fields%add_var(fieldname='Faxa_swndr' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_swndr) + call a2l_fields%add_var(fieldname='Faxa_swvdr' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_swvdr) + call a2l_fields%add_var(fieldname='Faxa_swndf' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_swndf) + call a2l_fields%add_var(fieldname='Faxa_swvdf' , units='unknown', available_from_data=.false., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_swvdf) + + call a2l_fields%add_var(fieldname='Faxa_bcphidry' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_bcphidry) + call a2l_fields%add_var(fieldname='Faxa_bcphodry' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_bcphodry) + call a2l_fields%add_var(fieldname='Faxa_bcphiwet' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_bcphiwet) + call a2l_fields%add_var(fieldname='Faxa_ocphidry' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_ocphidry) + call a2l_fields%add_var(fieldname='Faxa_ocphodry' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_ocphodry) + call a2l_fields%add_var(fieldname='Faxa_ocphiwet' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_ocphiwet) + call a2l_fields%add_var(fieldname='Faxa_dstwet1' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstwet1) + call a2l_fields%add_var(fieldname='Faxa_dstdry1' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstdry1) + call a2l_fields%add_var(fieldname='Faxa_dstwet2' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstwet2) + call a2l_fields%add_var(fieldname='Faxa_dstdry2' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstdry2) + call a2l_fields%add_var(fieldname='Faxa_dstwet3' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstwet3) + call a2l_fields%add_var(fieldname='Faxa_dstdry3' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstdry3) + call a2l_fields%add_var(fieldname='Faxa_dstwet4' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstwet4) + call a2l_fields%add_var(fieldname='Faxa_dstdry4' , units='unknown', available_from_data=.true., & + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstdry4) + + end subroutine create_a2l_field_list + + !----------------------------------------------------------------------- + subroutine create_l2a_field_list() + ! + ! !DESCRIPTION: + ! Create the list of fields passed from lnd -> atm. + ! + ! All of the lilac_l2a_* indices are valid after this is called. However, note that + ! l2a_fields still isn't fully usable until complete_l2a_field_list is called. + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'create_l2a_field_list' + !----------------------------------------------------------------------- + + call l2a_fields%init() + + call l2a_fields%add_var(fieldname='Sl_t' , units='unknown', & + field_index=lilac_l2a_Sl_t) + call l2a_fields%add_var(fieldname='Sl_tref' , units='unknown', & + field_index=lilac_l2a_Sl_tref) + call l2a_fields%add_var(fieldname='Sl_qref' , units='unknown', & + field_index=lilac_l2a_Sl_qref) + call l2a_fields%add_var(fieldname='Sl_avsdr' , units='unknown', & + field_index=lilac_l2a_Sl_avsdr) + call l2a_fields%add_var(fieldname='Sl_anidr' , units='unknown', & + field_index=lilac_l2a_Sl_anidr) + call l2a_fields%add_var(fieldname='Sl_avsdf' , units='unknown', & + field_index=lilac_l2a_Sl_avsdf) + call l2a_fields%add_var(fieldname='Sl_anidf' , units='unknown', & + field_index=lilac_l2a_Sl_anidf) + call l2a_fields%add_var(fieldname='Sl_snowh' , units='unknown', & + field_index=lilac_l2a_Sl_snowh) + call l2a_fields%add_var(fieldname='Sl_u10' , units='unknown', & + field_index=lilac_l2a_Sl_u10) + call l2a_fields%add_var(fieldname='Sl_fv' , units='unknown', & + field_index=lilac_l2a_Sl_fv) + call l2a_fields%add_var(fieldname='Sl_ram1' , units='unknown', & + field_index=lilac_l2a_Sl_ram1) + call l2a_fields%add_var(fieldname='Sl_z0m' , units='m' , & + field_index=lilac_l2a_Sl_z0m) + call l2a_fields%add_var(fieldname='Fall_taux' , units='unknown', & + field_index=lilac_l2a_Fall_taux) + call l2a_fields%add_var(fieldname='Fall_tauy' , units='unknown', & + field_index=lilac_l2a_Fall_tauy) + call l2a_fields%add_var(fieldname='Fall_lat' , units='unknown', & + field_index=lilac_l2a_Fall_lat) + call l2a_fields%add_var(fieldname='Fall_sen' , units='unknown', & + field_index=lilac_l2a_Fall_sen) + call l2a_fields%add_var(fieldname='Fall_lwup' , units='unknown', & + field_index=lilac_l2a_Fall_lwup) + call l2a_fields%add_var(fieldname='Fall_evap' , units='unknown', & + field_index=lilac_l2a_Fall_evap) + call l2a_fields%add_var(fieldname='Fall_swnet' , units='unknown', & + field_index=lilac_l2a_Fall_swnet) + call l2a_fields%add_var(fieldname='Fall_flxdst1' , units='unknown', & + field_index=lilac_l2a_Fall_flxdst1) + call l2a_fields%add_var(fieldname='Fall_flxdst2' , units='unknown', & + field_index=lilac_l2a_Fall_flxdst2) + call l2a_fields%add_var(fieldname='Fall_flxdst3' , units='unknown', & + field_index=lilac_l2a_Fall_flxdst3) + call l2a_fields%add_var(fieldname='Fall_flxdst4' , units='unknown', & + field_index=lilac_l2a_Fall_flxdst4) + + end subroutine create_l2a_field_list + + !----------------------------------------------------------------------- + subroutine complete_a2l_field_list(lsize_atm, fields_needed_from_data) + ! + ! !DESCRIPTION: + ! Complete the setup of a2l_fields. + ! + ! This is separated from create_a2l_field_list because lsize may not be available at + ! the point when that routine is called. Also, note that this sets + ! fields_needed_from_data, which won't be available until later in initialization. + ! + ! !ARGUMENTS: + integer, intent(in) :: lsize_atm ! number of atm points on this proc + + ! List of field indices that need to be read from data, because the host atmosphere + ! isn't going to provide them. These should be indices given in + ! ctsm_LilacCouplingFields (lilac_a2l_Faxa_bcphidry). This can be an empty list if no + ! fields need to be read from data. + integer , intent(in) :: fields_needed_from_data(:) + + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'complete_a2l_field_list' + !----------------------------------------------------------------------- + + call a2l_fields%complete_setup(lsize_atm) + call a2l_fields%set_needed_from_data(fields_needed_from_data) + + end subroutine complete_a2l_field_list + + !----------------------------------------------------------------------- + subroutine complete_l2a_field_list(lsize_atm) + ! + ! !DESCRIPTION: + ! Complete the setup of l2a_fields. + ! + ! This is separated from create_l2a_field_list because lsize may not be available at + ! the point when that routine is called. + ! + ! !ARGUMENTS: + integer, intent(in) :: lsize_atm ! number of atm points on this proc + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'complete_l2a_field_list' + !----------------------------------------------------------------------- + + call l2a_fields%complete_setup(lsize_atm) + + end subroutine complete_l2a_field_list + +end module ctsm_LilacCouplingFields diff --git a/lilac/src/ctsm_LilacLnd2AtmFieldListType.F90 b/lilac/src/ctsm_LilacLnd2AtmFieldListType.F90 new file mode 100644 index 0000000000..dfc1ec9857 --- /dev/null +++ b/lilac/src/ctsm_LilacLnd2AtmFieldListType.F90 @@ -0,0 +1,357 @@ +module ctsm_LilacLnd2AtmFieldListType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines a class and related methods for a list of lilac fields sent from lnd -> atm. + ! + ! (Note: this is very similar to LilacAtm2LndFieldListType. However, between the fact + ! that (1) they have different sets of supported methods, and (2) the use of the + ! dynamic vector, it seemed to make more sense to have totally separate classes rather + ! than trying to share code between the two.) + ! + ! To set up this list (lilac_lnd2atm_field_list_type): + ! + ! - Initialize it by calling the 'init' method + ! + ! - Add variables with add_var + ! + ! - When done adding variables, call complete_setup + ! - Note that you cannot access or perform any operations on any of the fields until + ! this is done! + ! + ! To use this list (after complete_setup has been called): + ! + ! - Query number of fields with num_fields + ! + ! - Extract data from a field with get_field + ! + ! !USES: + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : OOBMsg => shr_log_OOBMsg + use shr_sys_mod , only : shr_sys_abort + use lilac_constants, only : field_index_unset, logunit + + implicit none + private + + ! !PRIVATE TYPES: + + type, private :: lilac_lnd2atm_field_type + private + + ! Metadata set initially in initialization + character(len=:), allocatable :: fieldname + character(len=:), allocatable :: units + + ! Metadata set later in initialization + logical :: required_by_atm ! whether this field is actually required by the atmosphere + + ! Data set each time step + real(r8), pointer :: dataptr(:) + end type lilac_lnd2atm_field_type + + ! Define a dynamic vector for lilac_lnd2atm_field_type +#define VECTOR_NAME lilac_lnd2atm_field_vector +#define TYPE_NAME type(lilac_lnd2atm_field_type) +#define THROW(string) call shr_sys_abort(string) +#include "dynamic_vector_typedef.inc" + + ! + ! !PUBLIC TYPES: + type, public :: lilac_lnd2atm_field_list_type + private + type(lilac_lnd2atm_field_vector) :: field_vec + type(lilac_lnd2atm_field_type), allocatable :: fields(:) + contains + ! Methods for setting up the list: + procedure, public :: init + procedure, public :: add_var + procedure, public :: complete_setup + + ! Methods to query or set data: + procedure, public :: num_fields ! return the number of fields + procedure, public :: get_field ! get data for one field + procedure, public :: get_fieldname ! get the field name for a given field + procedure, public :: get_units ! get the units for a given field + procedure, public :: get_dataptr ! get a pointer to the data for a given field + + ! Private methods: + procedure, private :: check_field_index ! check whether a field index is valid + end type lilac_lnd2atm_field_list_type + + interface lilac_lnd2atm_field_type + module procedure new_lilac_lnd2atm_field_type + end interface lilac_lnd2atm_field_type + +contains + + ! Complete the dynamic vector definition. +#include "dynamic_vector_procdef.inc" + + !----------------------------------------------------------------------- + function new_lilac_lnd2atm_field_type(fieldname, units) result(this) + ! + ! !DESCRIPTION: + ! Initialize a new lilac_lnd2atm_field_type object + ! + ! !ARGUMENTS: + type(lilac_lnd2atm_field_type) :: this ! function result + character(len=*), intent(in) :: fieldname + character(len=*), intent(in) :: units + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'new_lilac_lnd2atm_field_type' + !----------------------------------------------------------------------- + + this%fieldname = fieldname + this%units = units + + ! Assume true until told otherwise + this%required_by_atm = .true. + + nullify(this%dataptr) + + end function new_lilac_lnd2atm_field_type + + !----------------------------------------------------------------------- + subroutine init(this) + ! + ! !DESCRIPTION: + ! Initialize a new lilac_lnd2atm_field_list_type object + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'init' + !----------------------------------------------------------------------- + + this%field_vec = lilac_lnd2atm_field_vector() + + end subroutine init + + !----------------------------------------------------------------------- + subroutine add_var(this, fieldname, units, field_index) + ! + ! !DESCRIPTION: + ! Add the given field to this list + ! + ! Also set field_index to be the index of this field in list. For the sake of error + ! checking, field_index should be initialized to field_index_unset before the call to + ! this subroutine. + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(inout) :: this + character(len=*), intent(in) :: fieldname + character(len=*), intent(in) :: units + integer, intent(inout) :: field_index + ! + ! !LOCAL VARIABLES: + type(lilac_lnd2atm_field_type) :: one_field + + character(len=*), parameter :: subname = 'add_var' + !----------------------------------------------------------------------- + + if (allocated(this%fields)) then + write(logunit,*) subname//' ERROR: this%fields is already allocated.' + write(logunit,*) 'fieldname = ', trim(fieldname) + write(logunit,*) 'This is likely a sign that you are trying to add a variable' + write(logunit,*) 'after complete_setup has already been called.' + call shr_sys_abort('Attempt to call '//subname//' after complete_setup was called') + end if + + if (field_index /= field_index_unset) then + write(logunit,*) subname//' ERROR: attempt to add var with a field index that has already been set.' + write(logunit,*) 'fieldname, field_index = ', trim(fieldname), field_index + call shr_sys_abort('Attempt to add var with a field index that has already been set') + end if + + one_field = lilac_lnd2atm_field_type( & + fieldname = trim(fieldname), & + units = trim(units)) + + call this%field_vec%push_back(one_field) + + field_index = this%field_vec%vsize() + end subroutine add_var + + !----------------------------------------------------------------------- + subroutine complete_setup(this, data_size) + ! + ! !DESCRIPTION: + ! Finalize the creation of this field list; this includes allocating the data arrays for each field + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(inout) :: this + integer, intent(in) :: data_size ! number of points in each field (assumed to be the same for all fields) + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'complete_setup' + !----------------------------------------------------------------------- + + call this%field_vec%move_out(this%fields) + + do i = 1, this%num_fields() + allocate(this%fields(i)%dataptr(data_size)) + end do + + end subroutine complete_setup + + !----------------------------------------------------------------------- + function num_fields(this) + ! + ! !DESCRIPTION: + ! Return the number of fields + ! + ! !ARGUMENTS: + integer :: num_fields ! function result + class(lilac_lnd2atm_field_list_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'num_fields' + !----------------------------------------------------------------------- + + if (.not. allocated(this%fields)) then + write(logunit,*) subname//' ERROR: this%fields has not yet been allocated' + write(logunit,*) 'This is likely a sign that you are trying to call num_fields' + write(logunit,*) 'before complete_setup has been called.' + call shr_sys_abort('Attempt to get number of fields before complete_setup was called') + end if + + num_fields = size(this%fields) + + end function num_fields + + !----------------------------------------------------------------------- + subroutine get_field(this, field_index, data) + ! + ! !DESCRIPTION: + ! Get data for the given field + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + real(r8), intent(out) :: data(:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_field' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + if (size(data) /= size(this%fields(field_index)%dataptr)) then + call shr_sys_abort(subname//' field size mismatch for '//trim(this%fields(field_index)%fieldname)) + end if + + data(:) = this%fields(field_index)%dataptr(:) + + end subroutine get_field + + !----------------------------------------------------------------------- + function get_fieldname(this, field_index) result(fieldname) + ! + ! !DESCRIPTION: + ! Get the field name for a given field + ! + ! (This will already be trimmed - no further trimming is needed.) + ! + ! !ARGUMENTS: + character(len=:), allocatable :: fieldname ! function result + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_fieldname' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + fieldname = this%fields(field_index)%fieldname + + end function get_fieldname + + !----------------------------------------------------------------------- + function get_units(this, field_index) result(units) + ! + ! !DESCRIPTION: + ! Get the units for a given field + ! + ! (This will already be trimmed - no further trimming is needed.) + ! + ! !ARGUMENTS: + character(len=:), allocatable :: units ! function result + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_units' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + units = this%fields(field_index)%units + + end function get_units + + !----------------------------------------------------------------------- + function get_dataptr(this, field_index) result(dataptr) + ! + ! !DESCRIPTION: + ! Get a pointer to the data for a given field + ! + ! !ARGUMENTS: + real(r8), pointer :: dataptr(:) ! function result + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_dataptr' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + dataptr => this%fields(field_index)%dataptr + + end function get_dataptr + + !----------------------------------------------------------------------- + subroutine check_field_index(this, field_index, caller) + ! + ! !DESCRIPTION: + ! Check the provided field_index for validity. If not valid, aborts. + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + character(len=*), intent(in) :: caller ! name of caller, for error messages + ! + ! !LOCAL VARIABLES: + integer :: nfields + + character(len=*), parameter :: subname = 'check_field_index' + !----------------------------------------------------------------------- + + if (field_index == field_index_unset) then + call shr_sys_abort(caller//':'//subname//' attempt to set field for unset field index') + end if + + if (field_index < 1 .or. field_index > this%num_fields()) then + write(logunit,*) caller//':'//subname//' ERROR: field_index out of bounds' + nfields = this%num_fields() + write(logunit,*) 'field_index, num_fields = ', field_index, nfields + call shr_sys_abort(caller//':'//subname//' field_index out of bounds') + end if + + end subroutine check_field_index + +end module ctsm_LilacLnd2AtmFieldListType diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 new file mode 100644 index 0000000000..f9098f4a89 --- /dev/null +++ b/lilac/src/lilac_atmaero.F90 @@ -0,0 +1,348 @@ +module lilac_atmaero + + !----------------------------------------------------------------------- + ! Contains methods for reading in atmosphere aerosal data + ! This will be done on the CTSM grid with the CTSM decomposition + ! (after the redistribution from atm-> lnd) + !----------------------------------------------------------------------- + + use ESMF + + ! share code uses + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : shr_log_errMsg + use shr_mpi_mod , only : shr_mpi_bcast + use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create + use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance + use shr_string_mod , only : shr_string_listAppend + use shr_cal_mod , only : shr_cal_ymd2date + use shr_pio_mod , only : shr_pio_getiotype + use mct_mod , only : mct_avect_indexra, mct_gsmap, mct_ggrid + use mct_mod , only : mct_gsmap_init, mct_gsmap_orderedpoints + use mct_mod , only : mct_ggrid_init, mct_ggrid_importIAttr, mct_ggrid_importRattr + + ! ctsm uses + use ncdio_pio , only : pio_subsystem + use domainMod , only : ldomain + use clm_time_manager , only : get_calendar + + ! lilac uses + use lilac_atmcap , only : gindex_atm + use lilac_methods , only : chkerr + use lilac_methods , only : lilac_methods_FB_getFieldN + use lilac_constants , only : field_index_unset + use ctsm_LilacCouplingFields, only : a2l_fields, lilac_atm2lnd + use ctsm_LilacCouplingFieldIndices + + implicit none + private + + type, private :: field_mapping_type + character(len=:), allocatable :: field_name + integer :: field_index = field_index_unset + end type field_mapping_type + + public :: lilac_atmaero_init ! initialize stream data type sdat + public :: lilac_atmaero_interp ! interpolates between two years of ndep file data + + ! module data + type(shr_strdata_type) :: sdat ! input data stream + + ! The first num_fields_to_read in the fields_to_read list are the fields that this + ! module will read from data. This is set up to have the same ordering as the fields in + ! sdat. + integer :: num_fields_to_read + type(field_mapping_type), allocatable :: fields_to_read(:) + + character(*),parameter :: u_file_u = & + __FILE__ + +!============================================================================== +contains +!============================================================================== + + subroutine lilac_atmaero_init(atm2cpl_state, rc) + + ! ---------------------------------------- + ! Initialize data stream information. + ! ---------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: atm2cpl_state + integer , intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: lmesh + type(ESMF_FieldBundle) :: lfieldbundle + type(ESMF_Field) :: lfield + type(mct_ggrid) :: ggrid_atm ! domain information + type(mct_gsmap) :: gsmap_atm ! decompositoin info + type(field_mapping_type), allocatable :: all_fields(:) ! all fields that can possibly be read from data + integer :: mytask ! mpi task number + integer :: mpicom ! mpi communicator + integer :: n ! index + integer :: field_index + integer :: lsize ! local size + integer :: gsize ! global size + integer :: nunit ! namelist input unit + integer :: ierr ! namelist i/o error flag + character(len=cl) :: stream_fldfilename ! name of input stream file + character(len=CL) :: mapalgo = 'bilinear' ! type of 2d mapping + character(len=CS) :: taxmode = 'extend' ! time extrapolation + character(len=CL) :: fldlistFile ! name of fields in input stream file + character(len=CL) :: fldlistModel ! name of fields in model + integer :: stream_year_first ! first year in stream to use + integer :: stream_year_last ! last year in stream to use + integer :: model_year_align ! align stream_year_first with model year + integer :: spatialDim + integer :: numOwnedElements + real(r8), pointer :: ownedElemCoords(:) + real(r8), pointer :: mesh_lons(:) + real(r8), pointer :: mesh_lats(:) + real(r8), pointer :: mesh_areas(:) + real(r8), pointer :: rdata(:) + integer , pointer :: idata(:) + !----------------------------------------------------------------------- + + namelist /atmaero_stream/ & + stream_year_first, stream_year_last, model_year_align, & + stream_fldfilename + + rc = ESMF_SUCCESS + + all_fields = [ & + field_mapping_type('BCDEPWET', lilac_a2l_Faxa_bcphiwet), & + field_mapping_type('BCPHODRY', lilac_a2l_Faxa_bcphodry), & + field_mapping_type('BCPHIDRY', lilac_a2l_Faxa_bcphidry), & + field_mapping_type('OCDEPWET', lilac_a2l_Faxa_ocphiwet), & + field_mapping_type('OCPHIDRY', lilac_a2l_Faxa_ocphidry), & + field_mapping_type('OCPHODRY', lilac_a2l_Faxa_ocphodry), & + field_mapping_type('DSTX01WD', lilac_a2l_Faxa_dstwet1), & + field_mapping_type('DSTX01DD', lilac_a2l_Faxa_dstdry1), & + field_mapping_type('DSTX02WD', lilac_a2l_Faxa_dstwet2), & + field_mapping_type('DSTX02DD', lilac_a2l_Faxa_dstdry2), & + field_mapping_type('DSTX03WD', lilac_a2l_Faxa_dstwet3), & + field_mapping_type('DSTX03DD', lilac_a2l_Faxa_dstdry3), & + field_mapping_type('DSTX04WD', lilac_a2l_Faxa_dstwet4), & + field_mapping_type('DSTX04DD', lilac_a2l_Faxa_dstdry4)] + + num_fields_to_read = 0 + allocate(fields_to_read(size(all_fields))) + fldlistFile = ' ' + fldlistModel = ' ' + do n = 1, size(all_fields) + field_index = all_fields(n)%field_index + if (a2l_fields%is_needed_from_data(field_index)) then + num_fields_to_read = num_fields_to_read + 1 + fields_to_read(num_fields_to_read) = all_fields(n) + call shr_string_listAppend(fldlistFile, fields_to_read(num_fields_to_read)%field_name) + call shr_string_listAppend(fldlistModel, a2l_fields%get_fieldname(field_index)) + end if + end do + + if (num_fields_to_read == 0) then + return + end if + + ! default values for namelist + stream_year_first = 1 ! first year in stream to use + stream_year_last = 1 ! last year in stream to use + model_year_align = 1 ! align stream_year_first with this model year + stream_fldFileName = ' ' + + ! get mytask and mpicom + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=mytask, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! Read namelist + if (mytask == 0) then + open(newunit=nunit, file='lilac_in', status='old', iostat=ierr ) + call shr_nl_find_group_name(nunit, 'atmaero_stream', status=ierr) + if (ierr == 0) then + read(nunit, atmaero_stream, iostat=ierr) + if (ierr /= 0) then + call shr_sys_abort(' ERROR reading namelist '//shr_log_errMsg(u_file_u, __LINE__)) + end if + else + call shr_sys_abort(' ERROR finding namelist '//shr_log_errMsg(u_file_u, __LINE__)) + end if + close(nunit) + endif + call shr_mpi_bcast(stream_year_first , mpicom) + call shr_mpi_bcast(stream_year_last , mpicom) + call shr_mpi_bcast(model_year_align , mpicom) + call shr_mpi_bcast(stream_fldfilename, mpicom) + + if (mytask == 0) then + print *, ' ' + print *, 'atmaero stream settings:' + print *, ' stream_year_first = ',stream_year_first + print *, ' stream_year_last = ',stream_year_last + print *, ' model_year_align = ',model_year_align + print *, ' stream_fldFileName = ',stream_fldFileName + print *, ' ' + endif + + ! ------------------------------ + ! create the mct gsmap + ! ------------------------------ + lsize = size(gindex_atm) + gsize = ldomain%ni * ldomain%nj + call mct_gsmap_init( gsmap_atm, gindex_atm, mpicom, 1, lsize, gsize ) + + ! ------------------------------ + ! obtain mesh lats, lons and areas + ! ------------------------------ + + call ESMF_StateGet(atm2cpl_state, 'a2c_fb', lfieldbundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_FB_getFieldN(lfieldbundle, fieldnum=1, field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(lmesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (numOwnedElements /= lsize) then + call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') + end if + allocate(ownedElemCoords(spatialDim*numOwnedElements)) + + call ESMF_MeshGet(lmesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(mesh_lons(numOwnedElements)) + allocate(mesh_lats(numOwnedElements)) + allocate(mesh_areas(numOwnedElements)) + do n = 1,numOwnedElements + mesh_lons(n) = ownedElemCoords(2*n-1) + mesh_lats(n) = ownedElemCoords(2*n) + mesh_areas(n) = 1.e36 ! hard-wire for now for testing + end do + + ! ------------------------------ + ! create the mct ggrid + ! ------------------------------ + call mct_ggrid_init( ggrid=ggrid_atm, CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize) + call mct_gsmap_orderedpoints(gsmap_atm, mytask, idata) + call mct_gGrid_importIAttr(ggrid_atm,'GlobGridNum', idata, lsize) + call mct_gGrid_importRattr(ggrid_atm,"lon" , mesh_lons , lsize) + call mct_gGrid_importRattr(ggrid_atm,"lat" , mesh_lats , lsize) + call mct_gGrid_importRattr(ggrid_atm,"area", mesh_areas, lsize) + allocate(rdata(lsize)) + rdata(:) = 1._R8 + call mct_gGrid_importRattr(ggrid_atm,"mask", rdata, lsize) + deallocate(mesh_lons, mesh_lats, mesh_areas, rdata) + + ! ------------------------------ + ! create the stream data sdat + ! ------------------------------ + call shr_strdata_create(sdat,& + name = "atmaero", & + pio_subsystem = pio_subsystem, & + pio_iotype = shr_pio_getiotype(compid= 1), & + mpicom = mpicom, & + compid = 1, & + gsmap = gsmap_atm, & + ggrid = ggrid_atm, & + nxg = ldomain%ni, & + nyg = ldomain%nj, & + yearFirst = stream_year_first, & + yearLast = stream_year_last, & + yearAlign = model_year_align, & + offset = 0, & + domFilePath = '', & + domfilename = trim(stream_fldfilename), & + domTvarName = 'time', & + domXvarName = 'lon' , & + domYvarName = 'lat' , & + domAreaName = 'area', & + domMaskName = 'mask', & + filePath = '', & + filename = (/trim(stream_fldfilename)/), & + fldListFile = trim(fldlistFile), & + fldListModel = trim(fldlistModel), & + fillalgo = 'none', & + mapalgo = mapalgo, & + calendar = get_calendar(), & + taxmode = taxmode ) + + if (mytask == 0) then + call shr_strdata_print(sdat,'ATMAERO data') + endif + + end subroutine lilac_atmaero_init + + !================================================================ + + subroutine lilac_atmaero_interp(clock, rc) + + ! input/output variables + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + integer :: mpicom ! mpi communicator + integer :: mytask ! mpi task number + type(ESMF_FieldBundle) :: lfieldbundle + type(ESMF_Time) :: currTime + integer :: yy, mm, dd, sec, curr_ymd + integer :: n + character(len=*), parameter :: subname='lilac_atmaero: [lilac_atmaero_interp]' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (num_fields_to_read == 0) then + return + end if + + ! get mytask and mpicom + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=mytask, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! get current time info + call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + ! advance the streams + call shr_strdata_advance(sdat, curr_ymd, sec, mpicom, 'atmaero') + + do n = 1, num_fields_to_read + call set_field(n) + end do + + end subroutine lilac_atmaero_interp + + !============================================================================== + + subroutine set_field(fieldnum) + + ! input/output data + integer, intent(in) :: fieldnum ! index into fields_to_read and sdat (which are assumed to have the same ordering) + + ! local data + integer :: field_index ! index in a2l_fields + !----------------------------------------------------------------------- + + field_index = fields_to_read(fieldnum)%field_index + call lilac_atm2lnd(field_index, sdat%avs(1)%rAttr(fieldnum,:)) + + end subroutine set_field + +end module lilac_atmaero diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 new file mode 100644 index 0000000000..911bb7b55f --- /dev/null +++ b/lilac/src/lilac_atmcap.F90 @@ -0,0 +1,319 @@ +module lilac_atmcap + + !----------------------------------------------------------------------- + ! This is an ESMF lilac cap for the host atmosphere + !----------------------------------------------------------------------- + + use ESMF + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use lilac_methods , only : chkerr + use lilac_constants, only : logunit + use ctsm_LilacCouplingFields, only : a2l_fields, l2a_fields + + implicit none + + public :: lilac_atmcap_init + public :: lilac_atmcap_register + + ! Time invariant input from host atmosphere + integer , public, allocatable :: gindex_atm(:) ! global index space + real(r8), private, allocatable :: atm_lons(:) ! local longitudes + real(r8), private, allocatable :: atm_lats(:) ! local latitudes + integer , public :: atm_global_nx + integer , public :: atm_global_ny + + ! Time variant input from host atmosphere + real(r8) :: nextsw_cday = 1.e36_r8 ! calendar day of the next sw calculation + + integer :: mytask + integer , parameter :: debug = 0 ! internal debug level + character(*), parameter :: u_FILE_u = & + __FILE__ + +!======================================================================== +contains +!======================================================================== + + subroutine lilac_atmcap_init_vars(atm_gindex_in, atm_lons_in, atm_lats_in, atm_global_nx_in, atm_global_ny_in) + + ! input/output variables + integer , intent(in) :: atm_gindex_in(:) + real(r8), intent(in) :: atm_lons_in(:) + real(r8), intent(in) :: atm_lats_in(:) + integer , intent(in) :: atm_global_nx_in + integer , intent(in) :: atm_global_ny_in + + ! glocal variables + integer :: n, lsize, fileunit + ! -------------------------------------------- + + lsize = size(atm_gindex_in) + allocate(gindex_atm(lsize)) + allocate(atm_lons(lsize)) + allocate(atm_lats(lsize)) + + ! set module variables + gindex_atm(:) = atm_gindex_in(:) + atm_lons(:) = atm_lons_in(:) + atm_lats(:) = atm_lats_in(:) + atm_global_nx = atm_global_nx_in + atm_global_ny = atm_global_ny_in + + end subroutine lilac_atmcap_init_vars + + !======================================================================== + subroutine lilac_atmcap_register (comp, rc) + + ! input/output variables + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + character(len=*), parameter :: subname='(lilac_atmcap_register): ' + !------------------------------------------------------------------------- + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + print *, "in user register routine" + end if + + ! Initialize return code + rc = ESMF_SUCCESS + + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=lilac_atmcap_init, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=lilac_atmcap_run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lilac_atmcap_final, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine lilac_atmcap_register + +!======================================================================== + + subroutine lilac_atmcap_init (comp, lnd2atm_state, atm2lnd_state, clock, rc) + + ! input/output variables + type (ESMF_GridComp) :: comp + type (ESMF_State) :: lnd2atm_state + type (ESMF_State) :: atm2lnd_state + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + integer :: fileunit + type(ESMF_Mesh) :: atm_mesh + type(ESMF_DistGrid) :: atm_distgrid + type(ESMF_Field) :: field + type(ESMF_FieldBundle) :: c2a_fb , a2c_fb + integer :: n, i, ierr + integer :: lsize + character(len=cl) :: atm_mesh_filename + character(len=cl) :: cvalue + integer :: spatialDim + integer :: numOwnedElements + real(r8), pointer :: ownedElemCoords(:) + real(r8) :: mesh_lon, mesh_lat + real(r8), parameter :: tolerance = 1.e-4_r8 + character(len=*), parameter :: subname='(lilac_atmcap_init): ' + !------------------------------------------------------------------------- + + namelist /lilac_atmcap_input/ atm_mesh_filename + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! Read in the atm mesh + !------------------------------------------------------------------------- + + ! read in mesh file name from namelist + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lilac_atmcap_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subname) // 'error reading in lilac_atmcap_input') + end if + close(fileunit) + + ! Note that in the call to lilac_atm the host atmospere sent both the gindex_atm and + ! the atm_mesh_filename that were then set as module variables here + + atm_distgrid = ESMF_DistGridCreate (arbSeqIndexList=gindex_atm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! TODO: the addUserArea failed for the 4x5 grid - need to have a + ! more robust approach - unless the area will simply be ignored for now? + ! atm_mesh = ESMF_MeshCreate(filename=trim(atm_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + ! elementDistGrid=atm_distgrid, addUserArea=.true., rc=rc) + atm_mesh = ESMF_MeshCreate(filename=trim(atm_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistGrid=atm_distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) then + call shr_sys_abort(trim(subname) // 'Error: failure in creating lilac atmcap from meshfile '//& + trim(atm_mesh_filename)) + end if + + call ESMF_LogWrite(trim(subname)//"Mesh for atmosphere is created for "//trim(atm_mesh_filename), ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, trim(subname) // "Mesh for atmosphere is created for "//trim(atm_mesh_filename) + end if + + !------------------------------------------------------------------------- + ! Check that lons and lats from the host atmospere match those read + ! in from the atm mesh file + !------------------------------------------------------------------------- + + call ESMF_MeshGet(atm_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + lsize = size(gindex_atm) + if (numOwnedElements /= lsize) then + print *, 'numOwnedElements in atm_mesh = ',numOwnedElements + print *, 'local size from gindex_atm from host atm = ',lsize + call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') + end if + + allocate(ownedElemCoords(spatialDim*numOwnedElements)) + call ESMF_MeshGet(atm_mesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1, lsize + mesh_lon = ownedElemCoords(2*n-1) + mesh_lat = ownedElemCoords(2*n) + if ( abs(mesh_lon - atm_lons(n)) > tolerance) then + write(logunit,101),n, atm_lons(n), mesh_lon +101 format('ERROR: lilac_atmcap: n, lon, mesh_lon = ',i6,2(f20.10,2x)) + call shr_sys_abort() + end if + if ( abs(mesh_lat - atm_lats(n)) > tolerance) then + write(logunit,102),n, atm_lats(n), mesh_lat +102 format('ERROR: lilac_atmcap: n, lat, mesh_lat = ',i6,2(f20.10,2x)) + call shr_sys_abort() + end if + end do + deallocate(ownedElemCoords) + + !------------------------------------------------------------------------- + ! Create a2c_fb field bundle and add to atm2lnd_state + !------------------------------------------------------------------------- + + ! create empty field bundle "a2c_fb" + a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create fields and add to field bundle + do n = 1, a2l_fields%num_fields() + field = ESMF_FieldCreate(atm_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & + name=a2l_fields%get_fieldname(n), farrayPtr=a2l_fields%get_dataptr(n), & + rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (debug > 0) then + call ESMF_FieldPrint(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + + ! add field bundle to atm2lnd_state + call ESMF_StateAdd(atm2lnd_state, (/a2c_fb/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//"lilac a2c_fb fieldbundle created and added to atm2lnd_state", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "lilac a2c_fb fieldbundle created and added to atm2lnd_state" + end if + + ! add nextsw_cday attributes + write(cvalue,*) nextsw_cday + call ESMF_AttributeSet(atm2lnd_state, name="nextsw_cday", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------------------------------------------------------------- + ! Create c2a_fb field bundle and add to lnd2atm_state + !------------------------------------------------------------------------- + + ! create empty field bundle "c2a_fb" + c2a_fb = ESMF_FieldBundleCreate (name="c2a_fb", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create fields and add to field bundle + do n = 1, l2a_fields%num_fields() + field = ESMF_FieldCreate(atm_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & + name=l2a_fields%get_fieldname(n), farrayPtr=l2a_fields%get_dataptr(n), & + rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (debug > 0) then + call ESMF_FieldPrint(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + + ! add field bundle to lnd2atm_state + call ESMF_StateAdd(lnd2atm_state, (/c2a_fb/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//"lilac c2a_fb fieldbundle is done and added to lnd2atm_state", ESMF_LOGMSG_INFO) + + end subroutine lilac_atmcap_init + +!======================================================================== + subroutine lilac_atmcap_run(comp, importState, exportState, clock, rc) + + ! input/output variables + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Initialize return code + ! This routine does nothing - its all in the atm->lnd coupler + rc = ESMF_SUCCESS + + end subroutine lilac_atmcap_run + +!======================================================================== + subroutine lilac_atmcap_final(comp, importState, exportState, clock, rc) + + ! input/output variables + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + character(len=*), parameter :: subname='( lilac_atmcap_final): ' + !------------------------------------------------------------------------- + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_StateGet(importState, "c2a_fb", import_fieldbundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(exportState, "a2c_fb", export_fieldbundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleDestroy(import_fieldbundle, rc=rc) + call ESMF_FieldBundleDestroy(export_fieldbundle, rc=rc) + + call ESMF_LogWrite(subname//"Finished lilac_atmcap_final", ESMF_LOGMSG_INFO) + + end subroutine lilac_atmcap_final + +end module lilac_atmcap diff --git a/lilac/src/lilac_constants.F90 b/lilac/src/lilac_constants.F90 new file mode 100644 index 0000000000..77edbfbe92 --- /dev/null +++ b/lilac/src/lilac_constants.F90 @@ -0,0 +1,18 @@ +module lilac_constants + + use shr_kind_mod, only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use shr_const_mod, only : SHR_CONST_SPVAL + + implicit none + public + + logical, parameter :: lilac_constants_statewrite_flag = .false. + real(R8), parameter :: lilac_constants_fillvalue = SHR_CONST_SPVAL + real(R8), parameter :: lilac_constants_czero = 0.0_R8 ! spval + integer, parameter :: lilac_constants_ispval_mask = -987987 ! spval for RH mask values + integer, parameter :: lilac_constants_SecPerDay = 86400 ! Seconds per day + integer :: lilac_constants_dbug_flag = 0 + integer, parameter :: field_index_unset = -1 + integer :: logunit = 6 ! TODO: fix/generalize this + +end module lilac_constants diff --git a/lilac/src/lilac_cpl.F90 b/lilac/src/lilac_cpl.F90 new file mode 100644 index 0000000000..86167e927b --- /dev/null +++ b/lilac/src/lilac_cpl.F90 @@ -0,0 +1,602 @@ +module lilac_cpl + + !----------------------------------------------------------------------- + ! Module containing all routines for couplers + !----------------------------------------------------------------------- + + use ESMF + use shr_sys_mod , only : shr_sys_abort + use lilac_methods, only : chkerr + + implicit none + private + + public :: cpl_atm2lnd_register + public :: cpl_lnd2atm_register + public :: cpl_lnd2rof_register + public :: cpl_rof2lnd_register + + type(ESMF_RouteHandle) :: rh_atm2lnd + type(ESMF_RouteHandle) :: rh_lnd2atm + type(ESMF_RouteHandle) :: rh_lnd2rof + type(ESMF_RouteHandle) :: rh_rof2lnd + + integer :: mytask + integer, parameter :: ispval_mask = -987987 ! spval for RH mask values + + character(*), parameter :: modname = "lilac_cpl" + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!====================================================================== +contains +!====================================================================== + + subroutine cpl_atm2lnd_register(cplcomp, rc) + + ! input/output variables + type(ESMF_CplComp ) :: cplcomp + integer, intent(out ) :: rc + + ! local variables + type(ESMF_VM) :: vm + character(len=*) , parameter :: subname=trim(modname ) //' : [cpl_atm2lnd_register] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + print *, "in cpl_atm2lnd_register routine" + end if + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_atm2lnd_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_atm2lnd_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + end subroutine cpl_atm2lnd_register + +!====================================================================== + + subroutine cpl_lnd2atm_register(cplcomp, rc) + + type(ESMF_CplComp) :: cplcomp + integer, intent(out ) :: rc + + ! local variables + character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_lnd2atm_register] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "in cpl_lnd2atm_register routine" + end if + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_lnd2atm_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN, userRoutine=cpl_lnd2atm_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE, userRoutine=cpl_lnd2atm_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + end subroutine cpl_lnd2atm_register + +!====================================================================== + + subroutine cpl_lnd2rof_register(cplcomp, rc) + + ! input/output variables + type(ESMF_CplComp ) :: cplcomp + integer, intent(out ) :: rc + + ! local variables + type(ESMF_VM) :: vm + character(len=*) , parameter :: subname=trim(modname ) //' : [cpl_atm2lnd_register] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + print *, "in cpl_atm2lnd_register routine" + end if + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_lnd2rof_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2rof_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_lnd2rof_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + end subroutine cpl_lnd2rof_register + +!====================================================================== + + subroutine cpl_rof2lnd_register(cplcomp, rc) + + type(ESMF_CplComp) :: cplcomp + integer, intent(out ) :: rc + + ! local variables + character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_rof2lnd_register] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "in cpl_rof2lnd_register routine" + end if + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_rof2lnd_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_rof2lnd_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_rof2lnd_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + end subroutine cpl_rof2lnd_register + +!====================================================================== + + subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) + + ! input/output variables + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + integer, intent(out ) :: rc + + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle + type (ESMF_FieldBundle) :: export_fieldbundle + character(len=*), parameter :: subname=trim(modname) //': [cpl_atm2lnd_init] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Coupler for atmosphere to land initialize routine called" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call cpl_get_fieldbundle(importState, 'a2c_fb', import_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call cpl_get_fieldbundle(exportState, 'c2l_fb_atm', export_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing cpl_atm2lnd') + + call ESMF_LogWrite(subname//"cpl_atm2lnd_init finished!", ESMF_LOGMSG_INFO) + + end subroutine cpl_atm2lnd_init + +!====================================================================== + + subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + integer, intent(out ) :: rc + + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle + type (ESMF_FieldBundle) :: export_fieldbundle + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_init] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Coupler for land to atmosphere initialize routine called" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call cpl_get_fieldbundle(importState, 'l2c_fb_atm', import_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call cpl_get_fieldbundle(exportState, 'c2a_fb', export_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing cpl_lnd2atm') + + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2atm_init + +!====================================================================== + + subroutine cpl_lnd2rof_init(cplcomp, importState, exportState, clock, rc) + + ! input/output variables + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + integer, intent(out ) :: rc + + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle + type (ESMF_FieldBundle) :: export_fieldbundle + integer :: srcTermProcessing_Value = 0 ! should this be a module variable? + character(len=*), parameter :: subname=trim(modname) //': [cpl_lnd2rof_init] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Coupler for atmosphere to land initialize routine called" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call cpl_get_fieldbundle(importState, 'l2c_fb_rof', import_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call cpl_get_fieldbundle(exportState, 'c2r_fb', export_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2rof, & + srcMaskValues=(/ispval_mask/), dstMaskValues=(/ispval_mask/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing cpl_lnd2rof') + + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2rof_init + +!====================================================================== + + subroutine cpl_rof2lnd_init(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + integer, intent(out ) :: rc + + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle + type (ESMF_FieldBundle) :: export_fieldbundle + integer :: srcTermProcessing_Value = 0 ! should this be a module variable? + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_rof2lnd_init] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + if (mytask == 0) then + print *, "Coupler for land to atmosphere initialize routine called" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call cpl_get_fieldbundle(importState, 'r2c_fb', import_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call cpl_get_fieldbundle(exportState, 'c2l_fb_rof', export_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_rof2lnd, & + srcMaskValues=(/ispval_mask/), dstMaskValues=(/ispval_mask/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing cpl_rof2lnd') + + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + + end subroutine cpl_rof2lnd_init + +!====================================================================== + + subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) + + ! input/output variables + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_run] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Running cpl_atm2lnd_run" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, "c2l_fb_atm", export_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" regridding fieldbundles from atmos to land!", ESMF_LOGMSG_INFO) + + end subroutine cpl_atm2lnd_run + +!====================================================================== + + subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) + + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_run] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Running cpl_lnd2atm_run" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "l2c_fb_atm", import_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2atm_run + +!====================================================================== + + subroutine cpl_lnd2rof_run(cplcomp, importState, exportState, clock, rc) + + ! input/output variables + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=* ) , parameter :: subname=trim(modname) //': [cpl_lnd2rof_run] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Running cpl_lnd2rof_run" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "l2c_fb_rof", import_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, "c2r_fb", export_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2rof, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" regridding fieldbundles from land to river!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2rof_run + +!====================================================================== + + subroutine cpl_rof2lnd_run(cplcomp, importState, exportState, clock, rc) + + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=*) , parameter :: subname=trim(modname) //': [cpl_rof2lnd_run] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Running cpl_rof2lnd_run" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "r2c_fb", import_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, "c2l_fb_rof", export_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_rof2lnd, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" regridding fieldbundles from river to land!", ESMF_LOGMSG_INFO) + + end subroutine cpl_rof2lnd_run + +!====================================================================== + + subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) + + ! input/output variables + type (ESMF_CplComp) :: cplcomp + type (ESMF_State) :: importState + type (ESMF_State) :: exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_final] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_atm2lnd, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" rh_atm2lnd route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_atm2lnd_final + +!====================================================================== + + subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp) :: cplcomp + type (ESMF_State) :: importState + type (ESMF_State) :: exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + character(len=*) , parameter :: subname=trim(modname) //': [cpl_lnd2atm_final] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2atm , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" rh_lnd2atm route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2atm_final + +!====================================================================== + + subroutine cpl_lnd2rof_final(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp) :: cplcomp + type (ESMF_State) :: importState + type (ESMF_State) :: exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + character(len=*) , parameter :: subname=trim(modname) //': [cpl_lnd2rof_final] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2rof , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" rh_lnd2rof route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2rof_final + +!====================================================================== + + subroutine cpl_rof2lnd_final(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp) :: cplcomp + type (ESMF_State) :: importState + type (ESMF_State) :: exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + character(len=*) , parameter :: subname=trim(modname) //': [cpl_rof2lnd_final] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_rof2lnd , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" rh_rof2lnd route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_rof2lnd_final + +!====================================================================== + + subroutine cpl_get_fieldbundle(state, fbname, fieldbundle, rc) + + ! input/output variables + type(ESMF_State) :: state + character(len=*) :: fbname + type(ESMF_FieldBundle) :: fieldbundle + integer, intent(out) :: rc + + ! local variables + integer :: n + integer :: fieldcount + character(len=128), allocatable :: fieldlist(:) + character(len=128) :: cvalue + character(len=*), parameter :: subname=trim(modname) //': [cpl_get_fieldbundle] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, trim(fbname), fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(fieldbundle, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) fieldcount + call ESMF_LogWrite(subname//" trim(fbname)//' field count = "//trim(cvalue), ESMF_LOGMSG_INFO) + allocate(fieldlist(fieldcount)) + + call ESMF_FieldBundleGet(fieldbundle, fieldNameList=fieldlist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,fieldCount + write(cvalue,*) n + call ESMF_LogWrite(subname//trim(fbname)//" field "//trim(cvalue)//' = '//trim(fieldlist(n)), & + ESMF_LOGMSG_INFO) + end do + deallocate(fieldlist) + if (mytask == 0) then + print *, trim(fbname)//' field count = ',fieldcount + end if + + end subroutine cpl_get_fieldbundle + +end module lilac_cpl diff --git a/lilac/src/lilac_history.F90 b/lilac/src/lilac_history.F90 new file mode 100644 index 0000000000..bc4967630d --- /dev/null +++ b/lilac/src/lilac_history.F90 @@ -0,0 +1,306 @@ +module lilac_history + + !----------------------------------------------------------------------------- + ! LILAC history output + !----------------------------------------------------------------------------- + + use ESMF + use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 + use shr_sys_mod , only : shr_sys_abort + use lilac_time , only : lilac_time_alarmInit + use lilac_atmcap , only : atm_nx => atm_global_nx + use lilac_atmcap , only : atm_ny => atm_global_ny + use lilac_constants , only : SecPerDay => lilac_constants_SecPerDay + use lilac_io , only : lilac_io_write, lilac_io_wopen, lilac_io_enddef + use lilac_io , only : lilac_io_close, lilac_io_date2yyyymmdd, lilac_io_sec2hms + use lilac_io , only : lilac_io_ymd2date + use lilac_methods , only : chkerr + + implicit none + private + + public :: lilac_history_init + public :: lilac_history_write + + character(CL) :: histfile_prefix + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lilac_history_init(clock, caseid, rc) + + ! ------------------------------------------ + ! Initialize lilac history file alarm + ! ------------------------------------------ + + ! input/output variables + type(ESMF_Clock) :: clock ! lilac clock + character(CL), intent(in) :: caseid + integer , intent(out) :: rc + + ! local variables + type(ESMF_Alarm) :: alarmhist + type(ESMF_Time) :: currtime + character(len=64) :: currtimestr + integer :: yr,mon,day,sec ! time units + character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + integer :: fileunit + integer :: ierr + character(CS) :: cvalue + character(CS) :: lilac_histfreq_option + integer :: lilac_histfreq_n + character(len=*), parameter :: subname='(lilac_history_init)' + !--------------------------------------- + + namelist /lilac_history_input/ lilac_histfreq_n, lilac_histfreq_option + + rc = ESMF_SUCCESS + + ! read in history file output frequencies + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lilac_history_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subname) // 'error reading in lilac_io_input') + end if + close(fileunit) + + write(histfile_prefix,"(2a)") trim(caseid),'.clm2.lilac_hi.' + + !--------------------------------------- + ! Get the clock info + !--------------------------------------- + + call ESMF_ClockGet(clock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) + + !--------------------------------------- + ! Initialize the history alarm + !--------------------------------------- + + call ESMF_LogWrite(trim(subname)//"Initializing lilac history alarm ", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//"Initializing lilac history frequency option "//trim(lilac_histfreq_option), & + ESMF_LOGMSG_INFO, rc=rc) + write(cvalue,*)lilac_histfreq_n + call ESMF_LogWrite(trim(subname)//"Initializing lilac history frequency "//trim(cvalue), & + ESMF_LOGMSG_INFO, rc=rc) + + call lilac_time_alarminit(clock, alarmhist, 'lilac_history_alarm', lilac_histfreq_option, lilac_histfreq_n, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine lilac_history_init + + !=============================================================================== + + subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & + lnd2cpl_state, cpl2lnd_state, rof2cpl_state, cpl2rof_state, clock, rc) + + ! ------------------------------ + ! Write lilac history file + ! ------------------------------ + + ! input/output variables + type(ESMF_State) :: atm2cpl_state + type(ESMF_State) :: cpl2atm_state + type(ESMF_State) :: lnd2cpl_state + type(ESMF_State) :: cpl2lnd_state + type(ESMF_State), optional :: rof2cpl_state + type(ESMF_State), optional :: cpl2rof_state + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_FieldBundle) :: c2a_fb, a2c_fb + type(ESMF_FieldBundle) :: c2l_fb_atm, c2l_fb_rof, l2c_fb_atm, l2c_fb_rof + type(ESMF_FieldBundle) :: c2r_fb, r2c_fb + type(ESMF_VM) :: vm + type(ESMF_Time) :: currtime + character(len=CS) :: currtimestr + type(ESMF_Time) :: starttime + type(ESMF_Time) :: nexttime + character(len=CS) :: nexttimestr + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_Calendar) :: calendar ! calendar type + integer :: i,j,m,n + integer :: start_ymd ! Starting date YYYYMMDD + integer :: start_tod ! Starting time-of-day (s) + integer :: nx,ny ! global grid size + integer :: yr,mon,day,sec ! time units + real(r8) :: rval ! real tmp value + real(r8) :: dayssince ! Time interval since reference time + character(CL) :: time_units ! units of time variable + character(CL) :: hist_file ! Local path to history filename + character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + real(r8) :: tbnds(2) ! CF1.0 time bounds + logical :: whead,wdata ! for writing restart/history cdf files + character(CL) :: cvalue + integer :: lnd_nx, lnd_ny + integer :: rof_nx, rof_ny + integer :: iam + character(len=*), parameter :: subname='(lilac_history_write)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the communicator and localpet + !--------------------------------------- + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Get the clock info + !--------------------------------------- + + call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) + + call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=rc) + timediff = nexttime - starttime + call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) + dayssince = day + sec/real(SecPerDay,R8) + + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call lilac_io_ymd2date(yr,mon,day,start_ymd) + start_tod = sec + time_units = 'days since ' // trim(lilac_io_date2yyyymmdd(start_ymd)) // ' ' // lilac_io_sec2hms(start_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! Write lilac history file + ! Use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for history file names + !--------------------------------------- + + write(hist_file,"(3a)") trim(histfile_prefix),trim(nexttimestr),'.nc' + call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=rc) + + call lilac_io_wopen(hist_file, vm, iam, clobber=.true.) + + do m = 1,2 + whead=.false. + wdata=.false. + if (m == 1) then + whead=.true. + elseif (m == 2) then + wdata=.true. + call lilac_io_enddef(hist_file) + endif + + tbnds = dayssince + + call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=rc) + if (tbnds(1) >= tbnds(2)) then + call lilac_io_write(hist_file, iam, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call lilac_io_write(hist_file, iam, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! obtain global sizes for lnd_nx and lnd_ny + call ESMF_AttributeGet(lnd2cpl_state, name="lnd_nx", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) lnd_nx + call ESMF_LogWrite(subname//"got attribute lnd_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + call ESMF_AttributeGet(lnd2cpl_state, name="lnd_ny", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) lnd_ny + call ESMF_LogWrite(subname//"got attribute lnd_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + + call ESMF_StateGet(atm2cpl_state, 'a2c_fb', a2c_fb) ! from atm + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, a2c_fb, & + nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='atm_to_cpl', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(cpl2atm_state, 'c2a_fb', c2a_fb) ! to atm + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2a_fb, & + nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_atm', l2c_fb_atm) ! from lnd + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, l2c_fb_atm, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_rof', l2c_fb_rof) ! from lnd + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, l2c_fb_rof, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_atm', c2l_fb_atm) ! to lnd + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2l_fb_atm, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_lnd_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(rof2cpl_state) .and. present(cpl2rof_state)) then + ! obtain global sizes for rof_nx and rof_ny + call ESMF_AttributeGet(rof2cpl_state, name="rof_nx", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) rof_nx + call ESMF_LogWrite(subname//"got attribute rof_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + call ESMF_AttributeGet(rof2cpl_state, name="rof_ny", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) rof_ny + call ESMF_LogWrite(subname//"got attribute rof_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + + call ESMF_StateGet(rof2cpl_state, 'r2c_fb', r2c_fb) ! from rof + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, r2c_fb, & + nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='rof_to_cpl', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(cpl2rof_state, 'c2r_fb', c2r_fb) ! to rof + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2r_fb, & + nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_rof', c2l_fb_rof) ! to rof + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2l_fb_rof, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=.true., wdata=wdata, pre='cpl_to_lnd_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + enddo + + call lilac_io_close(hist_file, iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine lilac_history_write + +end module lilac_history diff --git a/lilac/src/lilac_io.F90 b/lilac/src/lilac_io.F90 new file mode 100644 index 0000000000..f4eec5d485 --- /dev/null +++ b/lilac/src/lilac_io.F90 @@ -0,0 +1,1770 @@ +module lilac_io + + !------------------------------------------ + ! Create mediator history files + !------------------------------------------ + + use ESMF + use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl + use shr_kind_mod , only : r4=>shr_kind_r4, i8=>shr_kind_i8, r8=>shr_kind_r8 + use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat + use shr_sys_mod , only : shr_sys_abort + use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_constants , only : fillvalue => lilac_constants_fillvalue + use lilac_constants , only : logunit + use lilac_methods , only : FB_getFieldN => lilac_methods_FB_getFieldN + use lilac_methods , only : FB_getFldPtr => lilac_methods_FB_getFldPtr + use lilac_methods , only : FB_getNameN => lilac_methods_FB_getNameN + use lilac_methods , only : chkerr + use pio , only : file_desc_t, iosystem_desc_t, var_desc_t, io_desc_t, file_desc_t + use pio , only : PIO_DOUBLE, PIO_REAL, PIO_INT, PIO_CHAR,PIO_UNLIMITED, PIO_GLOBAL + use pio , only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, PIO_NOERR + use pio , only : pio_openfile, pio_createfile, pio_nowrite, pio_redef, pio_enddef, pio_closefile + use pio , only : pio_syncfile, pio_offset_kind + use pio , only : pio_initdecomp, pio_freedecomp + use pio , only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_noclobber, pio_setframe + use pio , only : pio_inq_dimid, pio_inq_dimlen, pio_inq_vardimid, pio_inq_varid, pio_inq_varndims + use pio , only : pio_def_dim, pio_def_var + use pio , only : pio_get_var, pio_get_att + use pio , only : pio_put_var, pio_put_att + use pio , only : pio_write, pio_write_darray + use pio , only : pio_read_darray + + implicit none + private + + ! public member functions: + public :: lilac_io_wopen + public :: lilac_io_close + public :: lilac_io_redef + public :: lilac_io_enddef + public :: lilac_io_sec2hms + public :: lilac_io_read + public :: lilac_io_write + public :: lilac_io_init + public :: lilac_io_date2yyyymmdd + public :: lilac_io_datetod2string + public :: lilac_io_ymd2date + + ! private member functions + private :: lilac_io_file_exists + + ! public data members: + interface lilac_io_read + module procedure lilac_io_read_FB + module procedure lilac_io_read_int + module procedure lilac_io_read_int1d + module procedure lilac_io_read_r8 + module procedure lilac_io_read_r81d + module procedure lilac_io_read_char + end interface lilac_io_read + interface lilac_io_write + module procedure lilac_io_write_FB + module procedure lilac_io_write_int + module procedure lilac_io_write_int1d + module procedure lilac_io_write_r8 + module procedure lilac_io_write_r81d + module procedure lilac_io_write_char + module procedure lilac_io_write_time + end interface lilac_io_write + interface lilac_io_date2ymd + module procedure lilac_io_date2ymd_int + module procedure lilac_io_date2ymd_long + end interface lilac_io_date2ymd + interface lilac_io_datetod2string + module procedure lilac_io_datetod2string_int + module procedure lilac_io_datetod2string_long + end interface lilac_io_datetod2string + interface lilac_io_ymd2date + module procedure lilac_io_ymd2date_int + module procedure lilac_io_ymd2date_long + end interface lilac_io_ymd2date + + !------------------------------------------------------------------------------- + ! module data + !------------------------------------------------------------------------------- + + type(iosystem_desc_t), pointer :: io_subsystem + integer :: pio_iotype + integer :: pio_ioformat + + integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now + type(file_desc_t) :: io_file(0:file_desc_t_cnt) + + character(*),parameter :: prefix = "lilac_io_" + character(*),parameter :: modName = "(lilac_io_mod) " + character(*),parameter :: version = "lilac0" + integer , parameter :: number_strlen = 2 + character(CL) :: wfilename = '' + character(*),parameter :: u_file_u = & + __FILE__ + +!================================================================================= +contains +!================================================================================= + + subroutine lilac_io_init() + + !--------------- + ! initialize module variables + !--------------- + + io_subsystem => shr_pio_getiosys(compid=1) + pio_iotype = shr_pio_getiotype(compid=1) + pio_ioformat = shr_pio_getioformat(compid=1) + + end subroutine lilac_io_init + + !=============================================================================== + logical function lilac_io_file_exists(vm, iam, filename) + + !--------------- + ! inquire if i/o file exists + !--------------- + + ! input/output variables + type(ESMF_VM) :: vm + integer, intent(in) :: iam + character(len=*), intent(in) :: filename + + ! local variables + integer :: tmp(1) + integer :: rc + !------------------------------------------------------------------------------- + + lilac_io_file_exists = .false. + if (iam==0) inquire(file=trim(filename),exist=lilac_io_file_exists) + if (lilac_io_file_exists) tmp(1) = 1 + + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(tmp(1) == 1) lilac_io_file_exists = .true. + + end function lilac_io_file_exists + + !=============================================================================== + subroutine lilac_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) + + !--------------- + ! open netcdf file + !--------------- + + ! input/output arguments + character(*), intent(in) :: filename + type(ESMF_VM) :: vm + integer, intent(in) :: iam + logical, optional, intent(in) :: clobber + integer, optional, intent(in) :: file_ind + character(CL), optional, intent(in) :: model_doi_url + + ! local variables + logical :: lclobber + integer :: rcode + integer :: nmode + integer :: lfile_ind + integer :: rc + character(CL) :: lversion + character(CL) :: lmodel_doi_url + character(*),parameter :: subName = '(lilac_io_wopen) ' + !------------------------------------------------------------------------------- + + lversion=trim(version) + + lclobber = .false. + if (present(clobber)) lclobber=clobber + + lmodel_doi_url = 'unset' + if (present(model_doi_url)) lmodel_doi_url = model_doi_url + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not. pio_file_is_open(io_file(lfile_ind))) then + + ! filename not open + wfilename = filename + + if (lilac_io_file_exists(vm, iam, filename)) then + if (lclobber) then + nmode = pio_clobber + ! only applies to classic NETCDF files. + if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then + nmode = ior(nmode,pio_ioformat) + endif + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + if(iam==0) write(logunit,*) subname,' create file ',trim(filename) + else + rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) + if (iam==0) then + write(logunit,*) subname,' open file ',trim(filename) + end if + call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) + rcode = pio_get_att(io_file(lfile_ind),PIO_GLOBAL,"file_version",lversion) + call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) + if (trim(lversion) /= trim(version)) then + rcode = pio_redef(io_file(lfile_ind)) + rcode = pio_put_att(io_file(lfile_ind),PIO_GLOBAL,"file_version",version) + rcode = pio_enddef(io_file(lfile_ind)) + endif + endif + else + nmode = pio_noclobber + ! only applies to classic NETCDF files. + if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then + nmode = ior(nmode,pio_ioformat) + endif + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + if (iam==0) then + write(logunit,*) subname,' create file ',trim(filename) + end if + rcode = pio_put_att(io_file(lfile_ind),PIO_GLOBAL,"file_version",version) + rcode = pio_put_att(io_file(lfile_ind),PIO_GLOBAL,"model_doi_url",lmodel_doi_url) + endif + elseif (trim(wfilename) /= trim(filename)) then + ! filename is open, better match open filename + if(iam==0) write(logunit,*) subname,' different filename currently open ',trim(filename) + if(iam==0) write(logunit,*) subname,' different wfilename currently open ',trim(wfilename) + call ESMF_LogWrite(subname//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + else + ! filename is already open, just return + endif + + end subroutine lilac_io_wopen + + !=============================================================================== + subroutine lilac_io_close(filename, iam, file_ind, rc) + + !--------------- + ! close netcdf file + !--------------- + + ! input/output variables + character(*), intent(in) :: filename + integer, intent(in) :: iam + integer,optional, intent(in) :: file_ind + integer , intent(out) :: rc + + ! local variables + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_close) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not. pio_file_is_open(io_file(lfile_ind))) then + ! filename not open, just return + elseif (trim(wfilename) == trim(filename)) then + ! filename matches, close it + call pio_closefile(io_file(lfile_ind)) + else + ! different filename is open, abort + if (iam==0) write(logunit,*) subname,' different filename currently open, aborting ',trim(filename) + if (iam==0) write(logunit,*) subname,' different wfilename currently open, aborting ',trim(wfilename) + call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + wfilename = '' + end subroutine lilac_io_close + + !=============================================================================== + subroutine lilac_io_redef(filename,file_ind) + + ! input/output variables + character(len=*), intent(in) :: filename + integer,optional,intent(in):: file_ind + + ! local variables + integer :: lfile_ind + integer :: rcode + !------------------------------------------------------------------------------- + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + rcode = pio_redef(io_file(lfile_ind)) + + end subroutine lilac_io_redef + + !=============================================================================== + subroutine lilac_io_enddef(filename,file_ind) + + ! input/output variables + character(len=*) , intent(in) :: filename + integer,optional , intent(in) :: file_ind + + ! local variables + integer :: lfile_ind + integer :: rcode + !------------------------------------------------------------------------------- + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + rcode = pio_enddef(io_file(lfile_ind)) + end subroutine lilac_io_enddef + + !=============================================================================== + character(len=24) function lilac_io_date2yyyymmdd (date) + + integer, intent(in) :: date ! date expressed as an integer: yyyymmdd + + call lilac_io_datetod2string(date_str = lilac_io_date2yyyymmdd, ymd = date) + + end function lilac_io_date2yyyymmdd + + !=============================================================================== + character(len=8) function lilac_io_sec2hms (seconds, rc) + + ! input arguments + integer, intent(in) :: seconds + integer, intent(out) :: rc + + ! local variables + integer :: hours ! hours of hh:mm:ss + integer :: minutes ! minutes of hh:mm:ss + integer :: secs ! seconds of hh:mm:ss + !---------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (seconds < 0 .or. seconds > 86400) then + write(logunit,*)'lilac_io_sec2hms: bad input seconds:', seconds + call ESMF_LogWrite('lilac_io_sec2hms: bad input seconds', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + hours = seconds / 3600 + minutes = (seconds - hours*3600) / 60 + secs = (seconds - hours*3600 - minutes*60) + + if (minutes < 0 .or. minutes > 60) then + write(logunit,*)'lilac_io_sec2hms: bad minutes = ',minutes + call ESMF_LogWrite('lilac_io_sec2hms: bad minutes', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + if (secs < 0 .or. secs > 60) then + write(logunit,*)'lilac_io_sec2hms: bad secs = ',secs + call ESMF_LogWrite('lilac_io_sec2hms: bad secs', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + write(lilac_io_sec2hms,80) hours, minutes, secs +80 format(i2.2,':',i2.2,':',i2.2) + + end function lilac_io_sec2hms + + !=============================================================================== + subroutine lilac_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & + fillval, pre, tavg, use_float, file_ind, rc) + + !--------------- + ! Write FB to netcdf file + !--------------- + + ! input/output variables + character(len=*), intent(in) :: filename ! file + integer, intent(in) :: iam ! local pet + type(ESMF_FieldBundle), intent(in) :: FB ! data to be written + logical, optional, intent(in) :: whead ! write header + logical, optional, intent(in) :: wdata ! write data + integer , optional, intent(in) :: nx ! 2d grid size if available + integer , optional, intent(in) :: ny ! 2d grid size if available + integer , optional, intent(in) :: nt ! time sample + real(r8), optional, intent(in) :: fillval ! fill value + character(len=*), optional, intent(in) :: pre ! prefix to variable name + logical, optional, intent(in) :: tavg ! is this a tavg + logical, optional, intent(in) :: use_float ! write output as float rather than double + integer, optional, intent(in) :: file_ind + integer, intent(out):: rc + + ! local variables + type(ESMF_Field) :: field + type(ESMF_Mesh) :: mesh + type(ESMF_Distgrid) :: distgrid + type(ESMF_VM) :: VM + integer :: mpicom + integer :: rcode + integer :: nf,ns,ng + integer :: k,n + integer :: ndims, nelements + integer ,target :: dimid2(2) + integer ,target :: dimid3(3) + integer ,pointer :: dimid(:) + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc + integer(kind=Pio_Offset_Kind) :: frame + character(CL) :: itemc ! string converted to char + character(CL) :: name1 ! var name + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + character(CL) :: lpre ! local prefix + logical :: lwhead, lwdata + logical :: luse_float + integer :: lnx,lny + real(r8) :: lfillvalue + integer, pointer :: minIndexPTile(:,:) + integer, pointer :: maxIndexPTile(:,:) + integer :: dimCount, tileCount + integer, pointer :: Dof(:) + integer :: lfile_ind + real(r8), pointer :: fldptr1(:) + real(r8), pointer :: fldptr2(:,:) + real(r8), allocatable :: ownedElemCoords(:), ownedElemCoords_x(:), ownedElemCoords_y(:) + character(len=number_strlen) :: cnumber + character(CL) :: tmpstr + type(ESMF_Field) :: lfield + integer :: rank + integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields + integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields + logical :: isPresent + character(*),parameter :: subName = '(lilac_io_write_FB) ' + !------------------------------------------------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_Success + + lfillvalue = fillvalue + if (present(fillval)) then + lfillvalue = fillval + endif + + lpre = ' ' + if (present(pre)) then + lpre = trim(pre) + endif + + if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + rc = ESMF_Success + return + endif + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + return + endif + + luse_float = .false. + if (present(use_float)) luse_float = use_float + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + write(tmpstr,*) subname//' field count = '//trim(lpre),nf + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (nf < 1) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + rc = ESMF_Success + return + endif + + call FB_getFieldN(FB, 1, field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, spatialDim=ndims, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write(tmpstr,*) subname, 'ndims, nelements = ', ndims, nelements + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + if (.not. allocated(ownedElemCoords) .and. ndims > 0 .and. nelements > 0) then + allocate(ownedElemCoords(ndims*nelements)) + allocate(ownedElemCoords_x(ndims*nelements/2)) + allocate(ownedElemCoords_y(ndims*nelements/2)) + + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ownedElemCoords_x = ownedElemCoords(1::2) + ownedElemCoords_y = ownedElemCoords(2::2) + end if + + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + ng = maxval(maxIndexPTile) + lnx = ng + lny = 1 + deallocate(minIndexPTile, maxIndexPTile) + + frame = -1 + if (present(nt)) then + frame = nt + endif + if (present(nx)) then + if (nx > 0) lnx = nx + endif + if (present(ny)) then + if (ny > 0) lny = ny + endif + if (lnx*lny /= ng) then + write(tmpstr,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call shr_sys_abort() + !This should not be an error for say CTSM which does not send a global grid + endif + + if (lwhead) then + rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_nx',lnx,dimid2(1)) + rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_ny',lny,dimid2(2)) + + if (present(nt)) then + dimid3(1:2) = dimid2 + rcode = pio_inq_dimid(io_file(lfile_ind),'time',dimid3(3)) + dimid => dimid3 + else + dimid => dimid2 + endif + + write(tmpstr,*) subname,' dimid = ',dimid + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + do k = 1,nf + call FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Determine rank of field with name itemc + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (rank == 2) then + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(cnumber,'(i0)') ungriddedUbound(1) + call ESMF_LogWrite(trim(subname)//':'//'field '//trim(itemc)// & + ' has an griddedUBound of '//trim(cnumber), ESMF_LOGMSG_INFO) + + ! Create a new output variable for each element of the undistributed dimension + do n = 1,ungriddedUBound(1) + if (trim(itemc) /= "hgt") then + write(cnumber,'(i0)') n + name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) + call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind), varid,"_FillValue",real(lfillvalue,r4)) + else + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + end if + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + if (present(tavg)) then + if (tavg) then + rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + endif + endif + end if + end do + else + name1 = trim(lpre)//'_'//trim(itemc) + call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO) + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", real(lfillvalue, r4)) + else + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", lfillvalue) + end if + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + if (present(tavg)) then + if (tavg) then + rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + endif + end if + end if + end do + + ! Add coordinate information to file + name1 = trim(lpre)//'_lon' + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) + else + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "longitude") + rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_east") + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "longitude") + + name1 = trim(lpre)//'_lat' + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) + else + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "latitude") + rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_north") + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "latitude") + + ! Finish define mode + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + + end if + + if (lwdata) then + + ! use distgrid extracted from field 1 above + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + + ! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + + deallocate(dof) + + do k = 1,nf + call FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call FB_getFldPtr(FB, itemc, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (rank == 2) then + + ! Determine the size of the ungridded dimension and the index where the undistributed dimension is located + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Output for each ungriddedUbound index + do n = 1,ungriddedUBound(1) + write(cnumber,'(i0)') n + name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) + rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + call pio_setframe(io_file(lfile_ind),varid,frame) + + if (gridToFieldMap(1) == 1) then + call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + else if (gridToFieldMap(1) == 2) then + call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + end if + end do + else if (rank == 1) then + name1 = trim(lpre)//'_'//trim(itemc) + rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + call pio_setframe(io_file(lfile_ind),varid,frame) + call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + end if ! end if rank is 2 or 1 + + end do ! end loop over fields in FB + + ! Fill coordinate variables + name1 = trim(lpre)//'_lon' + rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + call pio_setframe(io_file(lfile_ind),varid,frame) + call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + + name1 = trim(lpre)//'_lat' + rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + call pio_setframe(io_file(lfile_ind),varid,frame) + call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) + + call pio_syncfile(io_file(lfile_ind)) + call pio_freedecomp(io_file(lfile_ind), iodesc) + endif + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_io_write_FB + + !=============================================================================== + subroutine lilac_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write scalar integer to netcdf file + !--------------- + + ! intput/output variables + character(len=*) ,intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + integer ,intent(in) :: idata ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical,optional ,intent(in) :: whead ! write header + logical,optional ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc + + ! local variables + integer :: rcode + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_write_int) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (lwhead) then + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,idata) + ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata + endif + + end subroutine lilac_io_write_int + + !=============================================================================== + subroutine lilac_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write 1d integer array to netcdf file + !--------------- + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + integer ,intent(in) :: idata(:) ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + integer , intent(out) :: rc + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_write_int1d) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (lwhead) then + !rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + lnx = size(idata) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,idata) + endif + + ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata + + end subroutine lilac_io_write_int1d + + !=============================================================================== + subroutine lilac_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write scalar double to netcdf file + !--------------- + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + real(r8) ,intent(in) :: rdata ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc + + ! local variables + integer :: rcode + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_write_r8) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) + if (rcode==PIO_NOERR) then + !rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + end if + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + endif + + end subroutine lilac_io_write_r8 + + !=============================================================================== + subroutine lilac_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write 1d double array to netcdf file + !--------------- + + ! !INPUT/OUTPUT PARAMETERS: + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam + real(r8) ,intent(in) :: rdata(:) ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_write_r81d) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + lnx = size(rdata) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + !rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + endif + + end subroutine lilac_io_write_r81d + + !=============================================================================== + subroutine lilac_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write char string to netcdf file + !--------------- + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + character(len=*),intent(in) :: rdata ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(CL) :: charvar ! buffer for string read/write + character(*),parameter :: subName = '(lilac_io_write_char) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + lnx = len(charvar) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) + !rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + if (lwdata) then + charvar = '' + charvar = trim(rdata) + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,charvar) + endif + + end subroutine lilac_io_write_char + + !=============================================================================== + subroutine lilac_io_write_time(filename, iam, time_units, calendar, time_val, nt,& + whead, wdata, tbnds, file_ind, rc) + + !--------------- + ! Write time variable to netcdf file + !--------------- + + ! input/output variables + character(len=*) , intent(in) :: filename ! file + integer , intent(in) :: iam ! local pet + character(len=*) , intent(in) :: time_units ! units of time + type(ESMF_Calendar) , intent(in) :: calendar ! calendar + real(r8) , intent(in) :: time_val ! data to be written + integer , optional, intent(in) :: nt + logical , optional, intent(in) :: whead ! write header + logical , optional, intent(in) :: wdata ! write data + real(r8) , optional, intent(in) :: tbnds(2) ! time bounds + integer , optional, intent(in) :: file_ind + integer , intent(out):: rc + + ! local variables + integer :: rcode + integer :: dimid(1) + integer :: dimid2(2) + type(var_desc_t) :: varid + logical :: lwhead, lwdata + integer :: start(4),count(4) + real(r8) :: time_val_1d(1) + integer :: lfile_ind + character(CL) :: calname ! calendar name + character(*),parameter :: subName = '(lilac_io_write_time) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + ! Write out header + if (lwhead) then + rcode = pio_def_dim(io_file(lfile_ind),'time',PIO_UNLIMITED,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),'time',PIO_DOUBLE,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,'units',trim(time_units)) + + if (calendar == ESMF_CALKIND_360DAY) then + calname = '360_day' + else if (calendar == ESMF_CALKIND_GREGORIAN) then + calname = 'gregorian' + else if (calendar == ESMF_CALKIND_JULIAN) then + calname = 'julian' + else if (calendar == ESMF_CALKIND_JULIANDAY) then + calname = 'ESMF_CALKIND_JULIANDAY' + else if (calendar == ESMF_CALKIND_MODJULIANDAY) then + calname = 'ESMF_CALKIND_MODJULIANDAY' + else if (calendar == ESMF_CALKIND_NOCALENDAR) then + calname = 'none' + else if (calendar == ESMF_CALKIND_NOLEAP) then + calname = 'noleap' + end if + rcode = pio_put_att(io_file(lfile_ind),varid,'calendar',trim(calname)) + + if (present(tbnds)) then + dimid2(2) = dimid(1) + rcode = pio_put_att(io_file(lfile_ind),varid,'bounds','time_bnds') + rcode = pio_def_dim(io_file(lfile_ind),'ntb',2,dimid2(1)) + rcode = pio_def_var(io_file(lfile_ind),'time_bnds',PIO_DOUBLE,dimid2,varid) + endif + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + + ! Write out data + if (lwdata) then + start = 1 + count = 1 + if (present(nt)) then + start(1) = nt + endif + time_val_1d(1) = time_val + rcode = pio_inq_varid(io_file(lfile_ind),'time',varid) + rcode = pio_put_var(io_file(lfile_ind),varid,start,count,time_val_1d) + if (present(tbnds)) then + rcode = pio_inq_varid(io_file(lfile_ind),'time_bnds',varid) + start = 1 + count = 1 + if (present(nt)) then + start(2) = nt + endif + count(1) = 2 + rcode = pio_put_var(io_file(lfile_ind),varid,start,count,tbnds) + endif + endif + + end subroutine lilac_io_write_time + + !=============================================================================== + subroutine lilac_io_read_FB(filename, vm, iam, FB, pre, frame, rc) + + !--------------- + ! Read FB from netcdf file + !--------------- + + + ! input/output arguments + character(len=*) ,intent(in) :: filename ! file + type(ESMF_VM) ,intent(in) :: vm + integer ,intent(in) :: iam + type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read + character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name + integer(kind=PIO_OFFSET_KIND) ,optional ,intent(in) :: frame + integer ,intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: rcode + integer :: nf,ns,ng + integer :: k,n,l + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc + character(CL) :: itemc ! string converted to char + character(CL) :: name1 ! var name + character(CL) :: lpre ! local prefix + real(r8) :: lfillvalue + integer :: tmp(1) + integer :: rank, lsize + real(r8), pointer :: fldptr1(:), fldptr1_tmp(:) + real(r8), pointer :: fldptr2(:,:) + character(CL) :: tmpstr + character(len=16) :: cnumber + integer(kind=Pio_Offset_Kind) :: lframe + integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds + character(*),parameter :: subName = '(lilac_io_read_FB) ' + !------------------------------------------------------------------------------- + rc = ESMF_Success + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + lpre = ' ' + if (present(pre)) then + lpre = trim(pre) + endif + if (present(frame)) then + lframe = frame + else + lframe = 1 + endif + if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + return + endif + + call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(tmpstr,*) subname//' field count = '//trim(lpre),nf + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nf < 1) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + return + endif + + if (lilac_io_file_exists(vm, iam, trim(filename))) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//' ERROR: file invalid '//trim(filename), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) + + do k = 1,nf + ! Get name of field + call FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get iodesc for all fields based on iodesc of first field (assumes that all fields have + ! the same iodesc) + if (k == 1) then + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rank == 2) then + name1 = trim(lpre)//'_'//trim(itemc)//'1' + else if (rank == 1) then + name1 = trim(lpre)//'_'//trim(itemc) + end if + call lilac_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + call ESMF_LogWrite(trim(subname)//' reading field '//trim(itemc), ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get pointer to field bundle field + ! Field bundle might be 2d or 1d - but field on mediator history or restart file will always be 1d + call FB_getFldPtr(FB, itemc, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (rank == 2) then + + ! Determine the size of the ungridded dimension and the + ! index where the undistributed dimension is located + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (gridToFieldMap(1) == 1) then + lsize = size(fldptr2, dim=1) + else if (gridToFieldMap(1) == 2) then + lsize = size(fldptr2, dim=2) + end if + allocate(fldptr1_tmp(lsize)) + + do n = 1,ungriddedUBound(1) + ! Creat a name for the 1d field on the mediator history or restart file based on the + ! ungridded dimension index of the field bundle 2d fiedl + write(cnumber,'(i0)') n + name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call pio_setframe(pioid, varid, lframe) + call pio_read_darray(pioid, varid, iodesc, fldptr1_tmp, rcode) + rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue) + if (rcode /= pio_noerr) then + lfillvalue = fillvalue + endif + do l = 1,size(fldptr1_tmp) + if (fldptr1_tmp(l) == lfillvalue) fldptr1_tmp(l) = 0.0_r8 + enddo + else + fldptr1_tmp = 0.0_r8 + endif + if (gridToFieldMap(1) == 1) then + fldptr2(:,n) = fldptr1_tmp(:) + else if (gridToFieldMap(1) == 2) then + fldptr2(n,:) = fldptr1_tmp(:) + end if + end do + + deallocate(fldptr1_tmp) + + else if (rank == 1) then + name1 = trim(lpre)//'_'//trim(itemc) + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call pio_setframe(pioid,varid,lframe) + call pio_read_darray(pioid, varid, iodesc, fldptr1, rcode) + rcode = pio_get_att(pioid,varid,"_FillValue",lfillvalue) + if (rcode /= pio_noerr) then + lfillvalue = fillvalue + endif + do n = 1,size(fldptr1) + if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8 + enddo + else + fldptr1 = 0.0_r8 + endif + end if + + enddo ! end of loop over fields + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + + call pio_freedecomp(pioid, iodesc) + call pio_closefile(pioid) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_io_read_FB + + !=============================================================================== + subroutine lilac_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) + + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: name1 + type(file_desc_t) , intent(in) :: pioid + type(io_desc_t) , intent(inout) :: iodesc + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: field + type(ESMF_Mesh) :: mesh + type(ESMF_Distgrid) :: distgrid + integer :: rcode + integer :: ns,ng + integer :: n,ndims + integer, pointer :: dimid(:) + type(var_desc_t) :: varid + integer :: lnx,lny + integer :: tmp(1) + integer, pointer :: minIndexPTile(:,:) + integer, pointer :: maxIndexPTile(:,:) + integer :: dimCount, tileCount + integer, pointer :: Dof(:) + character(CL) :: tmpstr + integer :: rank + character(*),parameter :: subName = '(lilac_io_read_init_iodesc) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + + rcode = pio_inq_varndims(pioid, varid, ndims) + write(tmpstr,*) trim(subname),' ndims = ',ndims + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + allocate(dimid(ndims)) + rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) + rcode = pio_inq_dimlen(pioid, dimid(1), lnx) + write(tmpstr,*) trim(subname),' lnx = ',lnx + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (ndims>=2) then + rcode = pio_inq_dimlen(pioid, dimid(2), lny) + else + lny = 1 + end if + deallocate(dimid) + + write(tmpstr,*) trim(subname),' lny = ',lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ng = lnx * lny + + call FB_getFieldN(FB, 1, field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + if (ng > maxval(maxIndexPTile)) then + write(tmpstr,*) subname,' WARNING: dimensions do not match', lnx, lny, maxval(maxIndexPTile) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + !This should not be an error for CTSM which does not send a global grid + endif + + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + deallocate(dof) + + deallocate(minIndexPTile, maxIndexPTile) + + end if ! end if rcode check + + end subroutine lilac_io_read_init_iodesc + + !=============================================================================== + subroutine lilac_io_read_int(filename, vm, iam, idata, dname, rc) + + !--------------- + ! Read scalar integer from netcdf file + !--------------- + + ! input/output arguments + character(len=*) , intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + integer , intent(inout) :: idata ! integer data + character(len=*) , intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + integer :: i1d(1) + character(*),parameter :: subName = '(lilac_io_read_int) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call lilac_io_read_int1d(filename, vm, iam, i1d, dname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + idata = i1d(1) + + end subroutine lilac_io_read_int + + !=============================================================================== + subroutine lilac_io_read_int1d(filename, vm, iam, idata, dname, rc) + + !--------------- + ! Read 1d integer array from netcdf file + !--------------- + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer, intent(in) :: iam + integer , intent(inout) :: idata(:) ! integer data + character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + integer :: rcode + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + character(CL) :: lversion + character(CL) :: name1 + character(*),parameter :: subName = '(lilac_io_read_int1d) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lversion=trim(version) + + if (lilac_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,PIO_GLOBAL,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,idata) + + call pio_closefile(pioid) + end subroutine lilac_io_read_int1d + + !=============================================================================== + subroutine lilac_io_read_r8(filename, vm, iam, rdata, dname, rc) + + !--------------- + ! Read scalar double from netcdf file + !--------------- + + ! input/output arguments + character(len=*) , intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + real(r8) , intent(inout) :: rdata ! real data + character(len=*) , intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + real(r8) :: r1d(1) + character(*),parameter :: subName = '(lilac_io_read_r8) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call lilac_io_read_r81d(filename, vm, iam, r1d,dname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + rdata = r1d(1) + + end subroutine lilac_io_read_r8 + + !=============================================================================== + subroutine lilac_io_read_r81d(filename, vm, iam, rdata, dname, rc) + + !--------------- + ! Read 1d double array from netcdf file + !--------------- + + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + real(r8) , intent(inout) :: rdata(:) ! real data + character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + integer :: rcode + type(file_desc_T) :: pioid + type(var_desc_t) :: varid + character(CL) :: lversion + character(CL) :: name1 + character(*),parameter :: subName = '(lilac_io_read_r81d) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lversion=trim(version) + + if (lilac_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,PIO_GLOBAL,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,rdata) + + call pio_closefile(pioid) + end subroutine lilac_io_read_r81d + + !=============================================================================== + subroutine lilac_io_read_char(filename, vm, iam, rdata, dname, rc) + + !--------------- + ! Read char string from netcdf file + !--------------- + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer, intent(in) :: iam + character(len=*), intent(inout) :: rdata ! character data + character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + integer :: rcode + type(file_desc_T) :: pioid + type(var_desc_t) :: varid + character(CL) :: lversion + character(CL) :: name1 + character(CL) :: charvar ! buffer for string read/write + character(*),parameter :: subName = '(lilac_io_read_char) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lversion=trim(version) + + if (lilac_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + ! write(logunit,*) subname,' open file ',trim(filename) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,PIO_GLOBAL,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,charvar) + rdata = trim(charvar) + + call pio_closefile(pioid) + end subroutine lilac_io_read_char + + !=============================================================================== + subroutine lilac_io_date2ymd_int (date,year,month,day) + ! Converts coded-date (yyyymmdd) to year/month/day. + ! input/output variables + integer,intent(in) :: date ! coded-date (yyyymmdd) + integer,intent(out) :: year,month,day ! calendar year,month,day + ! local variables + integer :: tdate ! temporary date + !------------------------------------------------------------------------------- + + tdate = abs(date) + year =int(tdate/10000) + if (date < 0) year = -year + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + end subroutine lilac_io_date2ymd_int + + subroutine lilac_io_date2ymd_long (date,year,month,day) + ! Converts coded-date (yyyymmdd) to year/month/day. + ! input/output variables + integer(I8),intent(in) :: date ! coded-date ([yy]yyyymmdd) + integer ,intent(out) :: year,month,day ! calendar year,month,day + ! local variables + integer(I8) :: tdate ! temporary date + character(*),parameter :: subName = "(lilac_io_date2ymd_long)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year =int(tdate/10000) + if (date < 0) year = -year + month = int( mod(tdate,10000_I8)/ 100) + day = mod(tdate, 100_I8) + end subroutine lilac_io_date2ymd_long + + !=============================================================================== + subroutine lilac_io_datetod2string_int(date_str, ymd, tod) + ! Converts coded date (yyyymmdd) and optional time of day to a string like + ! 'yyyy-mm-dd-ttttt' (if tod is present) or 'yyyy-mm-dd' (if tod is absent). + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + + ! input/output variables + character(len=*) , intent(out) :: date_str + integer , intent(in) :: ymd + integer, optional, intent(in) :: tod + + ! local variables + integer :: yy, mm, dd + character(len=6) :: year_str + character(len=3) :: month_str + character(len=3) :: day_str + character(len=6) :: time_str + !--------------------------------------- + + call lilac_io_date2ymd(ymd, yy, mm, dd) + + ! Convert year, month, day and time of day to a string like 'yyyy-mm-dd-ttttt'. + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + write(year_str,'(i6.4)') yy + year_str = adjustl(year_str) + write(month_str,'(a,i2.2)') '-',mm + write(day_str ,'(a,i2.2)') '-',dd + if (present(tod)) then + write(time_str,'(a,i5.5)') '-',tod + else + time_str = ' ' + end if + date_str = trim(year_str) // trim(month_str) // trim(day_str) // trim(time_str) + + end subroutine lilac_io_datetod2string_int + + subroutine lilac_io_datetod2string_long(date_str, ymd, tod) + ! Converts coded date (yyyymmdd) and optional time of day to a string like + ! 'yyyy-mm-dd-ttttt' (if tod is present) or 'yyyy-mm-dd' (if tod is absent). + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + + ! input/output variables + character(len=*) , intent(out) :: date_str + integer(i8) , intent(in) :: ymd + integer, optional, intent(in) :: tod + + ! local variables + integer :: yy, mm, dd + character(len=6) :: year_str + character(len=3) :: month_str + character(len=3) :: day_str + character(len=6) :: time_str + !--------------------------------------- + + call lilac_io_date2ymd(ymd, yy, mm, dd) + + ! Convert year, month, day and time of day to a string like 'yyyy-mm-dd-ttttt'. + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + write(year_str,'(i6.4)') yy + year_str = adjustl(year_str) + write(month_str,'(a,i2.2)') '-',mm + write(day_str ,'(a,i2.2)') '-',dd + if (present(tod)) then + write(time_str,'(a,i5.5)') '-',tod + else + time_str = ' ' + end if + date_str = trim(year_str) // trim(month_str) // trim(day_str) // trim(time_str) + + end subroutine lilac_io_datetod2string_long + + !=============================================================================== + subroutine lilac_io_ymd2date_int(year,month,day,date) + ! Converts year, month, day to coded-date + + ! input/output variables + integer,intent(in ) :: year,month,day ! calendar year,month,day + integer,intent(out) :: date ! coded (yyyymmdd) calendar date + !--------------------------------------- + + ! NOTE: this calendar has a year zero (but no day or month zero) + date = abs(year)*10000 + month*100 + day ! coded calendar date + if (year < 0) date = -date + end subroutine lilac_io_ymd2date_int + + subroutine lilac_io_ymd2date_long(year,month,day,date) + ! Converts year, month, day to coded-date + + ! input/output variables + integer ,intent(in ) :: year,month,day ! calendar year,month,day + integer(I8),intent(out) :: date ! coded ([yy]yyyymmdd) calendar date + !--------------------------------------- + + ! NOTE: this calendar has a year zero (but no day or month zero) + date = abs(year)*10000_I8 + month*100 + day ! coded calendar date + if (year < 0) date = -date + end subroutine lilac_io_ymd2date_long + +end module lilac_io diff --git a/lilac/src/lilac_methods.F90 b/lilac/src/lilac_methods.F90 new file mode 100644 index 0000000000..eb2aa38dab --- /dev/null +++ b/lilac/src/lilac_methods.F90 @@ -0,0 +1,1702 @@ +module lilac_methods + + !----------------------------------------------------------------------------- + ! Generic operation methods used by the Mediator Component. + !----------------------------------------------------------------------------- + + use ESMF + use mpi , only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS + use shr_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_constants , only : czero => lilac_constants_czero + + implicit none + private + + interface lilac_methods_FB_accum ; module procedure & + lilac_methods_FB_accumFB2FB + end interface + + interface lilac_methods_FB_copy ; module procedure & + lilac_methods_FB_copyFB2FB + end interface + + interface lilac_methods_FieldPtr_compare ; module procedure & + lilac_methods_FieldPtr_compare1, & + lilac_methods_FieldPtr_compare2 + end interface + + ! used/reused in module + + logical :: isPresent + character(len=1024) :: msgString + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + character(*) , parameter :: u_FILE_u = & + __FILE__ + + public lilac_methods_FB_copy + public lilac_methods_FB_accum + public lilac_methods_FB_average + public lilac_methods_FB_reset + public lilac_methods_FB_clean + public lilac_methods_FB_diagnose + public lilac_methods_FB_FldChk + public lilac_methods_FB_GetFldPtr + public lilac_methods_FB_getNameN + public lilac_methods_FB_getFieldN + public lilac_methods_FB_getFieldByName + public lilac_methods_FB_getNumflds + public lilac_methods_FB_Field_diagnose + public lilac_methods_State_diagnose + public lilac_methods_State_GetFldPtr + public lilac_methods_State_SetScalar + public lilac_methods_State_GetScalar + public lilac_methods_Clock_TimePrint + public lilac_methods_FieldPtr_compare + public chkerr + + private lilac_methods_Mesh_Print + private lilac_methods_Mesh_Write + private lilac_methods_Field_GetFldPtr + private lilac_methods_FB_SetFldPtr + private lilac_methods_FB_copyFB2FB + private lilac_methods_FB_accumFB2FB + private lilac_methods_State_getNameN + private lilac_methods_State_SetFldPtr + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_getNameN(FB, fieldnum, fieldname, rc) + + ! ---------------------------------------------- + ! Get name of field number fieldnum in input field bundle FB + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + integer , intent(in) :: fieldnum + character(len=*) , intent(out) :: fieldname + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=*),parameter :: subname='(lilac_methods_FB_getNameN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + fieldname = ' ' + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldnum > fieldCount) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + fieldname = lfieldnamelist(fieldnum) + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_getNameN + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_getFieldN(FB, fieldnum, field, rc) + + ! ---------------------------------------------- + ! Get field with number fieldnum in input field bundle FB + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + integer , intent(in) :: fieldnum + type(ESMF_Field) , intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + character(len=ESMF_MAXSTR) :: name + character(len=*),parameter :: subname='(lilac_methods_FB_getFieldN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call lilac_methods_FB_getNameN(FB, fieldnum, name, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(FB, fieldName=name, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_getFieldN + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_getFieldByName(FB, fieldname, field, rc) + + ! ---------------------------------------------- + ! Get field associated with fieldname out of FB + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fieldname + type(ESMF_Field) , intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + character(len=*),parameter :: subname='(lilac_methods_FB_getFieldByName)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_getFieldByName + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_State_getNameN(State, fieldnum, fieldname, rc) + + ! ---------------------------------------------- + ! Get field number fieldnum name out of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: State + integer , intent(in) :: fieldnum + character(len=*), intent(out) :: fieldname + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=*),parameter :: subname='(lilac_methods_State_getNameN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + fieldname = ' ' + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldnum > fieldCount) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + fieldname = lfieldnamelist(fieldnum) + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_State_getNameN + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_clean(FB, rc) + + ! ---------------------------------------------- + ! Destroy fields in FB and FB + ! ---------------------------------------------- + + type(ESMF_FieldBundle), intent(inout) :: FB + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + type(ESMF_Field) :: field + character(len=*),parameter :: subname='(lilac_methods_FB_clean)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call ESMF_FieldBundleGet(FB, fieldName=lfieldnamelist(n), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + + call ESMF_FieldBundleDestroy(FB, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + deallocate(lfieldnamelist) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine lilac_methods_FB_clean + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_reset(FB, value, rc) + ! ---------------------------------------------- + ! Set all fields to value in FB + ! If value is not provided, reset to 0.0 + ! ---------------------------------------------- + + ! intput/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + real(R8) , intent(in), optional :: value + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8) :: lvalue + character(len=*),parameter :: subname='(lilac_methods_FB_reset)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lvalue = czero + if (present(value)) then + lvalue = value + endif + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call lilac_methods_FB_SetFldPtr(FB, lfieldnamelist(n), lvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_reset + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_average(FB, count, rc) + + ! ---------------------------------------------- + ! Set all fields to zero in FB + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + integer , intent(in) :: count + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:,:) + character(len=*),parameter :: subname='(lilac_methods_FB_average)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + if (count == 0) then + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": WARNING count is 0", ESMF_LOGMSG_INFO) + end if + !call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO) + !call lilac_methods_FB_reset(FB, value=spval, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + else + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldCount + call lilac_methods_FB_GetFldPtr(FB, lfieldnamelist(n), dataPtr1, dataPtr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + do i=lbound(dataptr1,1),ubound(dataptr1,1) + dataptr1(i) = dataptr1(i) / real(count, R8) + enddo + elseif (lrank == 2) then + do j=lbound(dataptr2,2),ubound(dataptr2,2) + do i=lbound(dataptr2,1),ubound(dataptr2,1) + dataptr2(i,j) = dataptr2(i,j) / real(count, R8) + enddo + enddo + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + enddo + deallocate(lfieldnamelist) + + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_average + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_diagnose(FB, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of FB + ! ---------------------------------------------- + + type(ESMF_FieldBundle) , intent(inout) :: FB + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) + character(len=CL) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*), parameter :: subname='(lilac_methods_FB_diagnose)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) // ' ' + endif + + ! Determine number of fields in field bundle and allocate memory for lfieldnamelist + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + ! Get the fields in the field bundle + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! For each field in the bundle, get its memory location and print out the field + do n = 1, fieldCount + call lilac_methods_FB_GetFldPtr(FB, lfieldnamelist(n), & + fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + enddo + + ! Deallocate memory + deallocate(lfieldnamelist) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine lilac_methods_FB_diagnose + + !----------------------------------------------------------------------------- + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_State_diagnose(State, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: State + character(len=*), intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=CS) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(lilac_methods_State_diagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + endif + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call lilac_methods_State_GetFldPtr(State, lfieldnamelist(n), & + fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_State_diagnose + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_Field_diagnose(FB, fieldname, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + character(len=*), intent(in) :: fieldname + character(len=*), intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: lrank + character(len=CS) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(lilac_methods_FB_FieldDiagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call lilac_methods_FB_GetFldPtr(FB, fieldname, dataPtr1d, dataPtr2d, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" + endif + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_Field_diagnose + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_copyFB2FB(FBout, FBin, rc) + + ! ---------------------------------------------- + ! Copy common field names from FBin to FBout + ! ---------------------------------------------- + + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_FieldBundle), intent(in) :: FBin + integer , intent(out) :: rc + character(len=*), parameter :: subname='(lilac_methods_FB_copyFB2FB)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + call lilac_methods_FB_accum(FBout, FBin, copy=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_copyFB2FB + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_accumFB2FB(FBout, FBin, copy, rc) + + ! ---------------------------------------------- + ! Accumulate common field names from FBin to FBout + ! If copy is passed in and true, the this is a copy + ! ---------------------------------------------- + + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_FieldBundle), intent(in) :: FBin + logical, optional , intent(in) :: copy + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lranki, lranko + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + logical :: exists + logical :: lcopy + real(R8), pointer :: dataPtri1(:) , dataPtro1(:) + real(R8), pointer :: dataPtri2(:,:), dataPtro2(:,:) + character(len=*), parameter :: subname='(lilac_methods_FB_accumFB2FB)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lcopy = .false. ! accumulate by default + if (present(copy)) then + lcopy = copy + endif + + call ESMF_FieldBundleGet(FBout, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FBout, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call ESMF_FieldBundleGet(FBin, fieldName=lfieldnamelist(n), isPresent=exists, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (exists) then + call lilac_methods_FB_GetFldPtr(FBin, lfieldnamelist(n), dataPtri1, dataPtri2, lranki, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call lilac_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtro1, dataPtro2, lranko, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lranki == 1 .and. lranko == 1) then + + if (.not.lilac_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do i=lbound(dataPtri1,1),ubound(dataPtri1,1) + dataPtro1(i) = dataPtri1(i) + enddo + else + do i=lbound(dataPtri1,1),ubound(dataPtri1,1) + dataPtro1(i) = dataPtro1(i) + dataPtri1(i) + enddo + endif + + elseif (lranki == 2 .and. lranko == 2) then + + if (.not.lilac_methods_FieldPtr_Compare(dataPtro2, dataPtri2, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do j=lbound(dataPtri2,2),ubound(dataPtri2,2) + do i=lbound(dataPtri2,1),ubound(dataPtri2,1) + dataPtro2(i,j) = dataPtri2(i,j) + enddo + enddo + else + do j=lbound(dataPtri2,2),ubound(dataPtri2,2) + do i=lbound(dataPtri2,1),ubound(dataPtri2,1) + dataPtro2(i,j) = dataPtro2(i,j) + dataPtri2(i,j) + enddo + enddo + endif + + else + + write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & + ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + + endif + + endif + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_accumFB2FB + + !----------------------------------------------------------------------------- + + logical function lilac_methods_FB_FldChk(FB, fldname, rc) + + ! ---------------------------------------------- + ! Determine if field with fldname is in input field bundle + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(lilac_methods_FB_FldChk)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + ! If field bundle is not created then set return to .false. + if (.not. ESMF_FieldBundleIsCreated(FB)) then + lilac_methods_FB_FldChk = .false. + return + end if + + ! If field bundle is created determine if fldname is present in field bundle + lilac_methods_FB_FldChk = .false. + + call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) then + call ESMF_LogWrite(trim(subname)//" Error checking field: "//trim(fldname), & + ESMF_LOGMSG_ERROR) + return + endif + if (isPresent) then + lilac_methods_FB_FldChk = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end function lilac_methods_FB_FldChk + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) + + ! ---------------------------------------------- + ! for a field, determine rank and return fldptr1 or fldptr2 + ! abort is true by default and will abort if fldptr is not yet allocated in field + ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + real(R8), pointer , intent(inout), optional :: fldptr1(:) + real(R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(lilac_methods_Field_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + ESMF_LOGMSG_INFO) + + elseif (lrank == 1) then + if (.not.present(fldptr1)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + elseif (lrank == 2) then + if (.not.present(fldptr2)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_Field_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) + + ! ---------------------------------------------- + ! Get pointer to a field bundle field + ! ---------------------------------------------- + + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + real(R8), pointer , intent(inout), optional :: fldptr1(:) + real(R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out), optional :: rank + integer , intent(out), optional :: rc + type(ESMF_Field) , intent(out), optional :: field + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + character(len=*), parameter :: subname='(lilac_methods_FB_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + if (.not. lilac_methods_FB_FldChk(FB, trim(fldname), rc=rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR field "//trim(fldname)//" not in FB ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_Field_GetFldPtr(lfield, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (present(rank)) then + rank = lrank + endif + if (present(field)) then + field = lfield + endif + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_SetFldPtr(FB, fldname, val, rc) + + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fldname + real(R8) , intent(in) :: val + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + character(len=*), parameter :: subname='(lilac_methods_FB_SetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call lilac_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + fldptr1 = val + elseif (lrank == 2) then + fldptr2 = val + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_SetFldPtr + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank, rc) + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(R8), pointer, intent(inout), optional :: fldptr1(:) + real(R8), pointer, intent(inout), optional :: fldptr2(:,:) + integer , intent(out), optional :: rank + integer , intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + character(len=*), parameter :: subname='(lilac_methods_State_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_Field_GetFldPtr(lfield, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (present(rank)) then + rank = lrank + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_State_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_State_SetFldPtr(ST, fldname, val, rc) + + type(ESMF_State) , intent(in) :: ST + character(len=*) , intent(in) :: fldname + real(R8), intent(in) :: val + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + character(len=*), parameter :: subname='(lilac_methods_State_SetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call lilac_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + fldptr1 = val + elseif (lrank == 2) then + fldptr2 = val + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_State_SetFldPtr + + !----------------------------------------------------------------------------- + + logical function lilac_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) + + real(R8), pointer, intent(in) :: fldptr1(:) + real(R8), pointer, intent(in) :: fldptr2(:) + character(len=*) , intent(in) :: cstring + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(lilac_methods_FieldPtr_Compare1)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lilac_methods_FieldPtr_Compare1 = .false. + if (lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & + ubound(fldptr2,1) /= ubound(fldptr1,1)) then + call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + else + lilac_methods_FieldPtr_Compare1 = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end function lilac_methods_FieldPtr_Compare1 + + !----------------------------------------------------------------------------- + + logical function lilac_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, rc) + + real(R8), pointer, intent(in) :: fldptr1(:,:) + real(R8), pointer, intent(in) :: fldptr2(:,:) + character(len=*) , intent(in) :: cstring + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(lilac_methods_FieldPtr_Compare2)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lilac_methods_FieldPtr_Compare2 = .false. + if (lbound(fldptr2,2) /= lbound(fldptr1,2) .or. & + lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & + ubound(fldptr2,2) /= ubound(fldptr1,2) .or. & + ubound(fldptr2,1) /= ubound(fldptr1,1)) then + call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + else + lilac_methods_FieldPtr_Compare2 = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end function lilac_methods_FieldPtr_Compare2 + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_Mesh_Print(mesh, string, rc) + + type(ESMF_Mesh) , intent(in) :: mesh + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Distgrid) :: distgrid + type(ESMF_DELayout) :: delayout + integer :: pdim, sdim, nnodes, nelements + integer :: localDeCount + integer :: DeCount + integer :: dimCount, tileCount + integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + type(ESMF_MeshStatus_Flag) :: meshStatus + logical :: elemDGPresent, nodeDGPresent + character(len=*),parameter :: subname='(lilac_methods_Mesh_Print)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_MeshGet(mesh, elementDistGridIsPresent=elemDGPresent, & + nodalDistgridIsPresent=nodeDGPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, status=meshStatus, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! first get the distgrid, which should be available + if (elemDGPresent) then + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=element" + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & + tileCount=tileCount, deCount=deCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + endif + + if (nodeDGPresent) then + call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=nodal" + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & + tileCount=tileCount, deCount=deCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + endif + + if (.not. elemDGPresent .and. .not. nodeDGPresent) then + call ESMF_LogWrite(trim(subname)//": cannot print distgrid from mesh", & + ESMF_LOGMSG_WARNING, rc=rc) + return + endif + + ! if mesh is complete, also get additional parameters + if (meshStatus==ESMF_MESHSTATUS_COMPLETE) then + ! access localDeCount to show this is a real Grid + call ESMF_MeshGet(mesh, parametricDim=pdim, spatialDim=sdim, & + numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": parametricDim=", pdim + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": spatialDim=", sdim + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedNodes=", nnodes + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedElements=", nelements + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_Mesh_Print + + +!----------------------------------------------------------------------------- + subroutine lilac_methods_Clock_TimePrint(clock,string,rc) + + ! input/output variables + type(ESMF_Clock) , intent(in) :: clock + character(len=*) , intent(in),optional :: string + integer , intent(out) :: rc + + ! local variables + type(ESMF_Time) :: time + type(ESMF_TimeInterval) :: timeStep + character(len=CS) :: timestr + character(len=CL) :: lstring + character(len=*), parameter :: subname='(lilac_methods_Clock_TimePrint)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + if (present(string)) then + lstring = trim(subname)//":"//trim(string) + else + lstring = trim(subname) + endif + + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock,starttime=time,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock,timestep=timestep,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": timestep = "//trim(timestr), ESMF_LOGMSG_INFO) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_Clock_TimePrint + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_Mesh_Write(mesh, string, rc) + + type(ESMF_Mesh) ,intent(in) :: mesh + character(len=*),intent(in) :: string + integer ,intent(out) :: rc + + ! local + integer :: n,l,i,lsize,ndims + character(len=CS) :: name + type(ESMF_DISTGRID) :: distgrid + type(ESMF_Array) :: array + real(R8), pointer :: rawdata(:) + real(R8), pointer :: coord(:) + character(len=*),parameter :: subname='(lilac_methods_Mesh_Write)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + +#if (1 == 0) + !--- elements --- + + call ESMF_MeshGet(mesh, spatialDim=ndims, numownedElements=lsize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(rawdata(ndims*lsize)) + allocate(coord(lsize)) + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, ownedElemCoords=rawdata, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ndims + name = "unknown" + if (n == 1) name = "lon_element" + if (n == 2) name = "lat_element" + do l = 1,lsize + i = 2*(l-1) + n + coord(l) = rawdata(i) + array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + + deallocate(rawdata,coord) + + !--- nodes --- + + call ESMF_MeshGet(mesh, spatialDim=ndims, numownedNodes=lsize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(rawdata(ndims*lsize)) + allocate(coord(lsize)) + + call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, ownedNodeCoords=rawdata, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ndims + name = "unknown" + if (n == 1) name = "lon_nodes" + if (n == 2) name = "lat_nodes" + do l = 1,lsize + i = 2*(l-1) + n + coord(l) = rawdata(i) + array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + + deallocate(rawdata,coord) +#else + call ESMF_LogWrite(trim(subname)//": turned off right now", ESMF_LOGMSG_INFO) +#endif + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_Mesh_Write + + !----------------------------------------------------------------------------- + +!================================================================================ + + subroutine lilac_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Get scalar data from State for a particular name and broadcast it to all other pets + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State), intent(in) :: state + integer, intent(in) :: scalar_id + real(R8), intent(out) :: scalar_value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, len, icount + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(R8), pointer :: farrayptr(:,:) + real(r8) :: tmp(1) + character(len=*), parameter :: subname='(lilac_methods_State_GetScalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! check item exist or not? + call ESMF_StateGet(State, itemSearch=trim(flds_scalar_name), itemCount=icount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (icount > 0) then + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scalar_value = tmp(1) + else + call ESMF_LogWrite(trim(subname)//": no ESMF_Field found named: "//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + end if + + end subroutine lilac_methods_State_GetScalar + +!================================================================================ + + subroutine lilac_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + + ! input/output arguments + real(R8), intent(in) :: scalar_value + integer, intent(in) :: scalar_id + type(ESMF_State), intent(inout) :: State + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: field + type(ESMF_VM) :: vm + real(R8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(lilac_methods_State_SetScalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + farrayptr(scalar_id,1) = scalar_value + endif + + end subroutine lilac_methods_State_SetScalar + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_getNumFlds(FB, string, nflds, rc) + + ! ---------------------------------------------- + ! Determine if fieldbundle is created and if so, the number of non-scalar + ! fields in the field bundle + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: string + integer , intent(out) :: nflds + integer , intent(inout) :: rc + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (.not. ESMF_FieldBundleIsCreated(FB)) then + call ESMF_LogWrite(trim(string)//": has not been created, returning", ESMF_LOGMSG_INFO) + nflds = 0 + else + ! Note - the scalar field has been removed from all mediator + ! field bundles - so this is why we check if the fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(FB, fieldCount=nflds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nflds == 0) then + call ESMF_LogWrite(trim(string)//": only has scalar data, returning", ESMF_LOGMSG_INFO) + end if + end if + + end subroutine lilac_methods_FB_getNumFlds + +!=============================================================================== + + logical function ChkErr(rc, line, file, mpierr) + + integer, intent(in) :: rc + integer, intent(in) :: line + + character(len=*), intent(in) :: file + logical, optional, intent(in) :: mpierr + + character(MPI_MAX_ERROR_STRING) :: lstring + integer :: dbrc, lrc, len, ierr + + ChkErr = .false. + lrc = rc + if (present(mpierr) .and. mpierr) then + if (rc == MPI_SUCCESS) return + call MPI_ERROR_STRING(rc, lstring, len, ierr) + call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) + lrc = ESMF_FAILURE + endif + + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + ChkErr = .true. + endif + + end function ChkErr + +end module lilac_methods + diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 new file mode 100644 index 0000000000..d98e3e080c --- /dev/null +++ b/lilac/src/lilac_mod.F90 @@ -0,0 +1,782 @@ +module lilac_mod + + !----------------------------------------------------------------------- + ! This is the driver for running CTSM, the ESMF lilac atm cap, and + ! optionally the MOSART river model that is put in place to ensure + ! that the host atmosphere does not need to know about ESMF + !----------------------------------------------------------------------- + + ! External libraries + use ESMF + use mct_mod , only : mct_world_init + + ! shr code routines + use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 + use shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8 => shr_kind_r8 + + ! lilac routines and data + use lilac_io , only : lilac_io_init + use lilac_time , only : lilac_time_clockinit, lilac_time_alarminit + use lilac_time , only : lilac_time_restart_write, lilac_time_restart_read + use lilac_atmaero , only : lilac_atmaero_init, lilac_atmaero_interp + use lilac_atmcap , only : lilac_atmcap_init_vars + use lilac_history , only : lilac_history_init + use lilac_history , only : lilac_history_write + use lilac_methods , only : chkerr + use lilac_constants, only : logunit + use ctsm_LilacCouplingFields, only : create_a2l_field_list, create_l2a_field_list + use ctsm_LilacCouplingFields, only : complete_a2l_field_list, complete_l2a_field_list + use ctsm_LilacCouplingFields, only : a2l_fields + + ! lilac register phaes + use lilac_atmcap , only : lilac_atmcap_register + use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register + use lilac_cpl , only : cpl_lnd2rof_register, cpl_rof2lnd_register + + ! ctsm register + use lnd_comp_esmf , only : lnd_register ! ctsm routine + + ! mosart register + use rof_comp_esmf , only : rof_register ! mosart routine + + implicit none + + public :: lilac_init1 + public :: lilac_init2 + public :: lilac_run + public :: lilac_final + + ! Gridded components and states in gridded components + type(ESMF_GridComp) :: atm_gcomp + type(ESMF_GridComp) :: lnd_gcomp + type(ESMF_GridComp) :: rof_gcomp + + ! Coupler components + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(ESMF_CplComp) :: cpl_lnd2rof_comp + type(ESMF_CplComp) :: cpl_rof2lnd_comp + + ! States + type(ESMF_State) :: atm2cpl_state, cpl2atm_state ! on atm mesh (1 field bundle) + type(ESMF_State) :: lnd2cpl_state, cpl2lnd_state ! on lnd mesh (2 field bundles) + type(ESMF_State) :: rof2cpl_state, cpl2rof_state ! on rof mesh (1 field bundle) + + ! Clock, TimeInterval, and Times + type(ESMF_Clock) :: lilac_clock + type(ESMF_Calendar),target :: lilac_calendar + type(ESMF_Alarm) :: lilac_restart_alarm + type(ESMF_Alarm) :: lilac_stop_alarm + + ! Coupling to mosart is now set to .false. by default + logical :: couple_to_river = .false. + + integer :: mytask + character(ESMF_MAXSTR) :: starttype + + character(*) , parameter :: modname = "lilac_mod" + character(*), parameter :: u_FILE_u = & + __FILE__ + +!======================================================================== +contains +!======================================================================== + + subroutine lilac_init1() + + ! -------------------------------------------------------------------------------- + ! This is called by the host atmosphere. This is phase 1 of the lilac initialization. + ! + ! Indices defined in lilac_coupling_fields (lilac_a2l_* and lilac_l2a_*) are not + ! valid until this is called. + ! -------------------------------------------------------------------------------- + + call create_a2l_field_list() + call create_l2a_field_list() + + end subroutine lilac_init1 + + + subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & + atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + starttype_in, fields_needed_from_data) + + ! -------------------------------------------------------------------------------- + ! This is called by the host atmosphere. This is phase 2 of the lilac initialization. + ! -------------------------------------------------------------------------------- + + ! input/output variables + integer , intent(inout) :: mpicom ! input commiunicator from atm + integer , intent(in) :: atm_global_index(:) + real(r8) , intent(in) :: atm_lons(:) + real(r8) , intent(in) :: atm_lats(:) + integer , intent(in) :: atm_global_nx + integer , intent(in) :: atm_global_ny + character(len=*) , intent(in) :: atm_calendar + integer , intent(in) :: atm_timestep + integer , intent(in) :: atm_start_year !(yyyy) + integer , intent(in) :: atm_start_mon !(mm) + integer , intent(in) :: atm_start_day + integer , intent(in) :: atm_start_secs + character(len=*) , intent(in) :: starttype_in + + ! List of field indices that need to be read from data, because the host atmosphere + ! isn't going to provide them. These should be indices given in + ! ctsm_LilacCouplingFields (lilac_a2l_Faxa_bcphidry). This can be an empty list if no + ! fields need to be read from data. + integer , intent(in) :: fields_needed_from_data(:) + + ! local variables + character(ESMF_MAXSTR) :: caseid + logical :: create_esmf_pet_files + type(ESMF_LogKind_Flag) :: logkindflag + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + integer :: yy,mm,dd,sec + integer :: lsize + type(ESMF_State) :: importState, exportState + type(ESMF_VM) :: vm + integer :: user_rc, rc + character(len=ESMF_MAXSTR) :: cname !components or cpl names + integer :: ierr + integer :: n, i + integer :: fileunit + integer, parameter :: debug = 1 !-- internal debug level + character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' + + ! initialization of mct and pio + integer :: ncomps = 1 ! for mct + integer, pointer :: mycomms(:) ! for mct + integer, pointer :: myids(:) ! for mct + integer :: compids(1) = (/1/) ! for pio_init2 - array with component ids + integer :: comms(1) ! for both mct and pio_init2 - array with mpicoms + character(len=32) :: compLabels(1) = (/'LND'/) ! for pio_init2 + character(len=64) :: comp_name(1) = (/'LND'/) ! for pio_init2 + logical :: comp_iamin(1) = (/.true./) ! for pio init2 + !------------------------------------------------------------------------ + + namelist /lilac_run_input/ caseid, create_esmf_pet_files + + ! Initialize return code + rc = ESMF_SUCCESS + + !------------------------------------------------------------------------- + ! Set module variable starttype + !------------------------------------------------------------------------- + starttype = starttype_in + + ! ------------------------------------------------------------------------ + ! Read main namelist + ! ------------------------------------------------------------------------ + + ! Initialize variables in case not set in namelist (but we expect them to be set) + caseid = 'UNSET' + create_esmf_pet_files = .false. + + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lilac_run_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subname) // 'error reading in lilac_run_input') + end if + close(fileunit) + + if (create_esmf_pet_files) then + logkindflag = ESMF_LOGKIND_MULTI + else + logkindflag = ESMF_LOGKIND_MULTI_ON_ERROR + end if + + ! ------------------------------------------------------------------------ + ! Complete setup of field lists started in lilac_init1, now that we know the number + ! of atm points. + ! ------------------------------------------------------------------------ + call complete_a2l_field_list(size(atm_global_index), fields_needed_from_data) + call complete_l2a_field_list(size(atm_global_index)) + + !------------------------------------------------------------------------- + ! Initialize pio with first initialization + ! AFTER call to MPI_init (which is in the host atm driver) and + ! BEFORE call to ESMF_Initialize + !------------------------------------------------------------------------- + call shr_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpicom) + + !------------------------------------------------------------------------- + ! Initialize ESMF, set the default calendar and log type. + !------------------------------------------------------------------------- + + ! NOTE: the default calendar is set to GREGORIAN and is reset below in the initialization of + ! the lilac clock + call ESMF_Initialize(mpiCommunicator=mpicom, defaultCalKind=ESMF_CALKIND_GREGORIAN, & + logkindflag=logkindflag, logappendflag=.false., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogSet(flush=.true.) + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !------------------------------------------------------------------------- + ! Initialize MCT (this is needed for data model functionality) + !------------------------------------------- + allocate(mycomms(1), myids(1)) + mycomms = (/mpicom/) ; myids = (/1/) + call mct_world_init(ncomps, mpicom, mycomms, myids) + call ESMF_LogWrite(subname//"initialized mct ... ", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! Initialize PIO with second initialization + !------------------------------------------------------------------------- + call shr_pio_init2(compids, compLabels, comp_iamin, (/mpicom/), (/mytask/)) + call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! Initial lilac atmosphere cap module variables + !------------------------------------------------------------------------- + ! This must be done BEFORE the atmcap initialization + call lilac_atmcap_init_vars(atm_global_index, atm_lons, atm_lats, atm_global_nx, atm_global_ny) + + !------------------------------------------------------------------------- + ! Create Gridded and Coupler Components + !------------------------------------------------------------------------- + cname = " LILAC atm cap " + atm_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac atmcap initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // "lilac atm cap gridded component created" + end if + + cname = " CTSM " + lnd_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac ctsm initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " ctsm gridded component created" + end if + + if (couple_to_river) then + cname = " MOSART " + rof_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac mosart initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " mosart gridded component created" + end if + end if + + cname = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_a2l initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler component (atmosphere to land) created" + end if + + cname = "Coupler from land to atmosphere" + cpl_lnd2atm_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2a initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler component (land to atmosphere) created" + end if + + if (couple_to_river) then + cname = "Coupler from river to land" + cpl_rof2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_r2l initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler component (river to land) created" + end if + + cname = "Coupler from land to river" + cpl_lnd2rof_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2r initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler component (land to river) created" + end if + end if + + !------------------------------------------------------------------------- + ! Register gridded and coupler components + !------------------------------------------------------------------------- + + ! Register section -- set services -- atmcap + call ESMF_GridCompSetServices(atm_gcomp, userRoutine=lilac_atmcap_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('atm_gcomp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('atm_gcomp register failure') + call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " lilac atm cap setservices finished" + end if + + ! Register section -- set services -- ctsm + call ESMF_GridCompSetServices(lnd_gcomp, userRoutine=lnd_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('lnd_gcomp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('lnd_gcomp register failure') + call ESMF_LogWrite(subname//"CSTM SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " CTSM setservices finished" + end if + + if (couple_to_river) then + ! Register section -- set services -- mosart + call ESMF_GridCompSetServices(rof_gcomp, userRoutine=rof_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') + call ESMF_LogWrite(subname//"MOSART SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " CTSM setservices finished" + end if + end if + + ! Register section -- set services -- coupler atmosphere to land + call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_atm2lnd_comp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_atm2lnd_comp register failure') + call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler from atmosphere to land setservices finished" + end if + + if (couple_to_river) then + ! Register section -- set services -- river to land + call ESMF_CplCompSetServices(cpl_rof2lnd_comp, userRoutine=cpl_rof2lnd_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') + call ESMF_LogWrite(subname//"Coupler from river to land SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler from river to land setservices finished" + end if + end if + + ! Register section -- set services -- coupler land to atmosphere + call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2atm_comp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2atm_comp register failure') + call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler from land to atmosphere setservices finished" + end if + + if (couple_to_river) then + ! Register section -- set services -- coupler land to river + call ESMF_CplCompSetServices(cpl_lnd2rof_comp, userRoutine=cpl_lnd2rof_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') + call ESMF_LogWrite(subname//"Coupler from land to river SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler from land to river setservices finished" + end if + end if + + !------------------------------------------------------------------------- + ! Create and initialize the lilac_clock, alarms and calendar + !------------------------------------------------------------------------- + + call lilac_time_clockInit(caseid, starttype, atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + lilac_clock, rc) + + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing clock") + call ESMF_LogWrite(subname//"lilac_clock initialized", ESMF_LOGMSG_INFO) + + ! ------------------------------------------------------------------------- + ! Initialize LILAC gridded components + ! First Create the empty import and export states used to pass data + ! between components. (these are module variables) + ! ------------------------------------------------------------------------- + + ! Create import and export states for atm_gcomp + atm2cpl_state = ESMF_StateCreate(name='state_from_atm', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + cpl2atm_state = ESMF_StateCreate(name='state_to_atm', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialze lilac_atm gridded component + call ESMF_GridCompInitialize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing atmcap") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing atmcap") + call ESMF_LogWrite(subname//"lilac_atm gridded component initialized", ESMF_LOGMSG_INFO) + + ! Create import and export states for lnd_gcomp (i.e. CTSM) + cpl2lnd_state = ESMF_StateCreate(name='state_to_land', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lnd2cpl_state = ESMF_StateCreate(name='state_fr_land', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Add caseid and starttype as attributes of cpl2lnd_state + call ESMF_AttributeSet(cpl2lnd_state, name="caseid", value=trim(caseid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(cpl2lnd_state, name="starttype", value=trim(starttype), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialze CTSM Gridded Component + call ESMF_GridCompInitialize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing ctsm") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing ctsm") + call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) + + if (couple_to_river) then + ! Create import and export states for rof_gcomp (i.e. MOSART) + cpl2rof_state = ESMF_StateCreate(name='state_to_river', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + rof2cpl_state = ESMF_StateCreate(name='state_fr_river', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize MOSART Gridded Component + call ESMF_GridCompInitialize(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing mosart") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing mosart") + call ESMF_LogWrite(subname//"MOSART gridded component initialized", ESMF_LOGMSG_INFO) + end if + + ! ------------------------------------------------------------------------- + ! Initialize LILAC coupler components + ! ------------------------------------------------------------------------- + + ! Note that the lnd2cpl_state and cpl2lnd_state are each made up of 2 field bundles, + ! one for the river and one for the atm - + ! The following fills in the atm field bundle in cpl2lnd_state + call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_atm2lnd component") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_atm2lnd component") + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + + ! The following maps the atm field bundle in lnd2cpl_state to the atm mesh + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2cpl_state, exportState=cpl2atm_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") + call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + + if (couple_to_river) then + ! The following maps the rof field bundle in lnd2cpl_state to the rof mesh + call ESMF_CplCompInitialize(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2rof component") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2rof component") + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + + ! The following fills in the rof field bundle in cpl2lnd_state + call ESMF_CplCompInitialize(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") + call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + end if + + if (mytask == 0) then + write(logunit,*) trim(subname) // "finished lilac initialization" + end if + + !------------------------------------------------------------------------- + ! Initialize atmaero stream data (using share strearm capability from CIME) + !------------------------------------------------------------------------- + + call lilac_atmaero_init(atm2cpl_state, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_atmaero_init") + + !------------------------------------------------------------------------- + ! Initialize lilac_io_mod module data + !------------------------------------------------------------------------- + + call lilac_io_init() + call ESMF_LogWrite(subname//"initialized lilac io ...", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! Initialize lilac history output + !------------------------------------------------------------------------- + + call lilac_history_init(lilac_clock, caseid, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_history_init") + call ESMF_LogWrite(subname//"initialized lilac history output ...", ESMF_LOGMSG_INFO) + + end subroutine lilac_init2 + + !======================================================================== + + subroutine lilac_run(write_restarts_now, stop_now) + + ! input/output variables + logical, intent(in) :: write_restarts_now ! if true, CTSM will write restarts at end of time step + logical, intent(in) :: stop_now ! if true, CTSM will do some finalization at end of time step + + ! local variables + type(ESMF_Alarm) :: lilac_history_alarm + type(ESMF_Alarm) :: lilac_restart_alarm + type(ESMF_State) :: importState, exportState + integer :: user_rc, rc + character(len=*), parameter :: subname=trim(modname)//': [lilac_run] ' + !------------------------------------------------------------------------ + + rc = ESMF_SUCCESS + + if (mytask == 0) then + write(logunit,*) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + write(logunit,*) " Lilac Run " + write(logunit,*) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + end if + + ! Note that the lilac caps for ctsm and possible mosart will + ! listen to the restart and stop alarms on the lilac clock + + ! Set the clock restart alarm if restart_alarm_ringing is true + if (write_restarts_now) then + ! Turn on lilac restart alarm (this will be needed by ctsm) + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_restart_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") + call ESMF_AlarmRingerOn(lilac_restart_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") + call ESMF_LogWrite(subname//"lilac restart alarm is ringing", ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("Error in querying lilac restart alarm ring") + + ! Write out lilac restart output if lilac_restart_alarm is ringing + call lilac_time_restart_write(lilac_clock, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in restart write") + end if + + ! Set the clock stop alarm if stop_alarm_ringing is true + if (stop_now) then + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_stop_alarm', lilac_stop_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_stop_alarm") + call ESMF_AlarmRingerOn(lilac_stop_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") + call ESMF_LogWrite(subname//"lilac stop alarm is ringing", ESMF_LOGMSG_INFO) + end if + + ! Run lilac atmcap - update the cpl2atm_state + call ESMF_LogWrite(subname//"running lilac atmos_cap", ESMF_LOGMSG_INFO) + if (mytask == 0) write(logunit,*) "Running atmos_cap gridded component , rc =", rc + call ESMF_GridCompRun(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") + + ! Update prescribed aerosols atm2cpl_a_state + call lilac_atmaero_interp(lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac_atmaero_interp") + + ! Make sure all atm2lnd fields have been set + call a2l_fields%check_all_set() + + ! Run cpl_atm2lnd + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_atm2lnd_comp" + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_atm2lnd") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_atm2lnd") + + ! Run ctsm + ! Write ctsm restart file if lilac_restart_alarm is ringing + ! Finalize ctsm if lilac_stop_alarm is ringing + call ESMF_LogWrite(subname//"running ctsm", ESMF_LOGMSG_INFO) + if (mytask == 0) write(logunit,*) "Running ctsm" + call ESMF_GridCompRun(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") + + ! Run cpl_lnd2atm + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + end if + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2cpl_state, exportState=cpl2atm_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in cpl_lnd2atm") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in cpl_lnd2atm") + + if (couple_to_river) then + ! Run cpl_lnd2rof + call ESMF_LogWrite(subname//"running cpl_lnd2rof_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_lnd2rof_comp" + call ESMF_CplCompRun(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_lnd2rof") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_lnd2rof") + + ! Run mosart + ! Write mosart restart file if lilac_restart_alarm is ringing + ! Finalize mosart if lilac_stop_alarm is ringing + call ESMF_LogWrite(subname//"running mosart", ESMF_LOGMSG_INFO) + if (mytask == 0) write(logunit,*) "Running mosart" + call ESMF_GridCompRun(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running rof") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running rof") + + ! Run cpl_rof2lnd + ! TODO: uncommenting this needs to be tested + ! call ESMF_LogWrite(subname//"running cpl_rof2lnd_comp ", ESMF_LOGMSG_INFO) + ! if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_rof2lnd_comp" + ! call ESMF_CplCompRun(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & + ! clock=lilac_clock, userRc=user_rc, rc=rc) + ! if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_rof2lnd") + ! if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_rof2lnd") + end if + + ! Write out lilac history output if lilac_history_alarm is ringing + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_history_alarm', lilac_history_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_history_alarm") + if (ESMF_AlarmIsRinging(lilac_history_alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("Error in querying lilac history alarm ring") + call ESMF_AlarmRingerOff( lilac_history_alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("Error in turning ringer off in lilac history alarm") + if (couple_to_river) then + call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & + rof2cpl_state=rof2cpl_state, cpl2rof_state=cpl2rof_state, clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") + else + call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") + end if + end if + + if (write_restarts_now) then + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_restart_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") + call ESMF_AlarmRingerOff( lilac_restart_alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Reset atm2lnd provided flags for next time step + call a2l_fields%reset_provided() + + ! Advance the lilac clock at the end of the time step + call ESMF_ClockAdvance(lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in advancing time step") + call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) "time is icremented now... (ClockAdvance) , rc =", rc + end if + + end subroutine lilac_run + +!======================================================================== + + subroutine lilac_final( ) + + ! local variables + type(ESMF_State) :: importState, exportState + integer :: rc, user_rc + character(len=*), parameter :: subname=trim(modname)//': [lilac_final] ' + !------------------------------------------------------------------------ + + ! Initialize return code + rc = ESMF_SUCCESS + + if (mytask == 0) then + write(logunit,*) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + write(logunit,*) " Lilac Finalizing " + write(logunit,*) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + end if + + ! Gridded Component Finalizing! --- atmosphere + call ESMF_GridCompFinalize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, clock=lilac_clock, & + userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) "Finalizing atmos_cap gridded component , rc =", rc + end if + + ! Coupler component Finalizing --- coupler atmos to land + call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, clock=lilac_clock, & + userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc + end if + + ! Gridded Component Finalizing! --- land + call ESMF_GridCompFinalize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, clock=lilac_clock, & + userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) "Finalizing lnd_cap gridded component , rc =", rc + end if + + ! Coupler component Finalizing --- coupler land to atmos + call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=cpl2lnd_state, exportState=cpl2atm_state, clock=lilac_clock, & + userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc + end if + + ! Then clean them up + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"destroying all states ", ESMF_LOGMSG_INFO) + + if (mytask == 0) then + write(logunit,*) "ready to destroy all states" + end if + call ESMF_StateDestroy(atm2cpl_state , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(cpl2atm_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2cpl_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(cpl2lnd_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + if (couple_to_river) then + call ESMF_StateDestroy(rof2cpl_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(cpl2rof_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end if + + call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) "ready to destroy all components" + end if + + call ESMF_GridCompDestroy(atm_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_GridCompDestroy(lnd_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + if (couple_to_river) then + call ESMF_GridCompDestroy(rof_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end if + + call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_lnd2atm_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) "end of Lilac Finalization routine" + end if + + ! Finalize ESMF; keep mpi alive so that atmosphere can do any finalization needed + ! before it calls MPI_Finalize + call ESMF_Finalize (endflag=ESMF_END_KEEPMPI) + + end subroutine lilac_final + +end module lilac_mod diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 new file mode 100644 index 0000000000..e372c7dcff --- /dev/null +++ b/lilac/src/lilac_time.F90 @@ -0,0 +1,545 @@ +module lilac_time + + use ESMF + use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 + use shr_sys_mod , only : shr_sys_abort + use shr_cal_mod , only : shr_cal_ymd2date + use lilac_io , only : lilac_io_write, lilac_io_wopen, lilac_io_enddef + use lilac_io , only : lilac_io_close, lilac_io_date2yyyymmdd, lilac_io_sec2hms + use lilac_methods , only : chkerr + use lilac_constants, only : logunit + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr + use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close + + implicit none + private ! default private + + public :: lilac_time_clockinit ! initialize the lilac clock + public :: lilac_time_alarminit ! initialize an alarm + public :: lilac_time_restart_write ! only writes the time info + public :: lilac_time_restart_read ! only reads the time info + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNone = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNSeconds = "nseconds" , & + optNMinutes = "nminutes" , & + optNHours = "nhours" , & + optNDays = "ndays" , & + optNMonths = "nmonths" , & + optNYears = "nyears" + + ! Module data + character(len=ESMF_MAXSTR) :: caseid + type(ESMF_Calendar) :: lilac_calendar + integer :: mytask + integer, parameter :: SecPerDay = 86400 ! Seconds per day + + ! We'll use this really big year to effectively mean infinitely into the future. + integer, parameter :: really_big_year = 999999999 + + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + lilac_clock, rc) + + ! ------------------------------------------------- + ! Initialize the lilac clock + ! ------------------------------------------------- + + ! input/output variables + character(len=*) , intent(in) :: caseid_in + character(len=*) , intent(in) :: starttype + character(len=*) , intent(in) :: atm_calendar + integer , intent(in) :: atm_timestep + integer , intent(in) :: atm_start_year !(yyyy) + integer , intent(in) :: atm_start_mon !(mm) + integer , intent(in) :: atm_start_day + integer , intent(in) :: atm_start_secs + type(ESMF_Clock) , intent(inout) :: lilac_clock + integer , intent(out) :: rc + + ! local variables + type(ESMF_Alarm) :: lilac_restart_alarm + type(ESMF_Alarm) :: lilac_stop_alarm + type(ESMF_Clock) :: clock + type(ESMF_VM) :: vm + type(ESMF_Time) :: StartTime ! Start time + type(ESMF_Time) :: CurrTime ! Current time + type(ESMF_Time) :: Clocktime ! Loop time + type(ESMF_TimeInterval) :: TimeStep ! Clock time-step + type(ESMF_TimeInterval) :: TimeStep_advance + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! Start time of day (seconds) + integer :: curr_ymd ! Current ymd (YYYYMMDD) + integer :: curr_tod ! Current tod (seconds) + character(len=CL) :: restart_file + character(len=CL) :: restart_pfile + integer :: yr, mon, day, secs ! Year, month, day, seconds as integers + integer :: unitn ! unit number + integer :: ierr ! Return code + integer :: tmp(2) ! Array for Broadcast + character(len=*), parameter :: subname = '(lilactime_clockInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + caseid = trim(caseid_in) + + ! ------------------------------ + ! get my task + ! ------------------------------ + + call ESMF_VMGetCurrent(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ------------------------------ + ! create lilac_calendar + ! ------------------------------ + + if (trim(atm_calendar) == 'NOLEAP') then + lilac_calendar = ESMF_CalendarCreate(name='NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + else if (trim(atm_calendar) == 'GREGORIAN') then + lilac_calendar = ESMF_CalendarCreate(name='GREGORIAN', calkindflag=ESMF_CALKIND_GREGORIAN, rc=rc ) + else + call shr_sys_abort(trim(subname)//'ERROR: only NOLEAP and GREGORIAN calendars currently supported') + end if + call ESMF_CalendarSetDefault(lilac_calendar, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort(trim(subname)//'ERROR: default calendar set error') + + ! ------------------------------ + ! create and initialize lilac_clock + ! ------------------------------ + + call ESMF_TimeIntervalSet(TimeStep, s=atm_timestep, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeSet(StartTime, yy=atm_start_year, mm=atm_start_mon, dd=atm_start_day , s=atm_start_secs, & + calendar=lilac_calendar, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Create the lilac clock + ! NOTE: the reference time is set to the start time + ! NOTE: no stop time is given. Stopping will be determined via an argument passed to lilac_run. + lilac_clock = ESMF_ClockCreate(name='lilac_clock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort(trim(subname)//'error initializing lilac clock') + + ! ------------------------------ + ! For a continue run - obtain current time from the lilac restart file and + ! advance the clock to the current time for a continue run + ! ------------------------------ + + if (starttype == 'continue') then + + ! Read the pointer file to obtain the restart file, read the restart file for curr_ymd and curr_tod + ! and then convert this to an esmf current time (currtime) + if (mytask == 0) then + restart_pfile = 'rpointer.lilac' + call ESMF_LogWrite(trim(subname)//" reading rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) call shr_sys_abort(trim(subname)//' ERROR rpointer file open returns error') + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) call shr_sys_abort(trim(subname)//' ERROR rpointer file read returns error') + close(unitn) + call ESMF_LogWrite(trim(subname)//" read driver restart from "//trim(restart_file), ESMF_LOGMSG_INFO) + + ! Read the restart file on mastertask and then broadcast the data + call lilac_time_restart_read(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + tmp(1) = curr_ymd ; tmp(2) = curr_tod + endif + call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + curr_ymd = tmp(1) ; curr_tod = tmp(2) + + ! Determine current time + yr = int(curr_ymd/10000) + mon = int( mod(curr_ymd,10000)/ 100) + day = mod(curr_ymd, 100) + call ESMF_TimeSet( currtime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine the current time from the lilac clock + call ESMF_ClockGet(lilac_clock, currtime=clocktime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Compute the time step difference from the current time from the restart file to the current lilac clock time + ! (which is really just the start time) + + TimeStep_advance = currtime - clocktime + call ESMF_TimeIntervalGet(timestep_advance, s=secs, rc=rc) + if (mytask == 0) write(logunit,*)'DEBUG: time step advance is ',secs + + ! Advance the clock to the current time (in case of a restart) + call ESMF_ClockAdvance (lilac_clock, timestep=timestep_advance, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing restart alarm') + + end if + + ! Write out diagnostic info + if (mytask == 0) then + print *, trim(subname) // "---------------------------------------" + call ESMF_CalendarPrint (lilac_calendar , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockPrint (lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + print *, trim(subname) // "---------------------------------------" + end if + + ! Add a restart alarm and stop alarm to the clock. + ! + ! These alarms are initially set up to never go off, but they are turned on by + ! arguments passed to lilac_run. + ! + ! NOTE: The history alarm will be added in lilac_history_init and can go off multiple times during the run + + call lilac_time_alarmInit(lilac_clock, lilac_restart_alarm, 'lilac_restart_alarm', & + option = optNever, opt_n = -1, rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call lilac_time_alarmInit(lilac_clock, lilac_stop_alarm, 'lilac_stop_alarm', & + option = optNever, opt_n = -1, rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine lilac_time_clockInit + +!=============================================================================== + + subroutine lilac_time_alarmInit( clock, alarm, alarmname, option, opt_n, rc) + + ! Setup an alarm in a clock + ! The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: alarmname ! alarm name + character(len=*) , intent(in) :: option ! alarm option + integer , intent(in) :: opt_n ! alarm freq (ignored for option of optNone or optNever) + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + integer :: sec + character(len=*), parameter :: subname = '(lilac_time_alarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initial guess of next alarm, this will be updated below + NextAlarm = CurrTime + + ! Get calendar from clock + call ESMF_ClockGet(clock, calendar=cal) + + ! Determine inputs for call to create alarm + if (trim(option) /= optNone .and. trim(option) /= optNever) then + if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n - must be > 0') + end if + select case (trim(option)) + + case (optNone, optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=really_big_year, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=really_big_year, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNSteps) + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYears) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case default + call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + + end select + + ! ------------------------------------------------- + ! AlarmInterval and NextAlarm should be set + ! ------------------------------------------------- + + ! advance Next Alarm so it won't ring on first timestep for + ! most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=alarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//'created lilac alarm '//trim(alarmname), ESMF_LOGMSG_INFO) + + end subroutine lilac_time_alarmInit + +!=============================================================================== + + subroutine lilac_time_restart_write(clock, rc) + + ! ------------------------------------------------- + ! Write lilac restart time info + ! ------------------------------------------------- + + ! Input/output variables + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Time) :: currtime, starttime, nexttime + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_Calendar) :: calendar + character(len=64) :: currtimestr, nexttimestr + integer :: i,j,m,n,n1,ncnt + integer :: curr_ymd ! Current date YYYYMMDD + integer :: curr_tod ! Current time-of-day (s) + integer :: start_ymd ! Starting date YYYYMMDD + integer :: start_tod ! Starting time-of-day (s) + integer :: next_ymd ! Starting date YYYYMMDD + integer :: next_tod ! Starting time-of-day (s) + integer :: nx,ny ! global grid size + integer :: yr,mon,day,sec ! time units + real(R8) :: dayssince ! Time interval since reference time + integer :: unitn ! unit number + character(ESMF_MAXSTR) :: time_units ! units of time variable + character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename + character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename + character(ESMF_MAXSTR) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + logical :: write_header ! true => write netcdf header + logical :: write_data ! true => write netcdf data + character(len=*), parameter :: subname='(lilac_time_phases_restart_write)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) + + call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=rc) + + timediff = nexttime - starttime + call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) + dayssince = day + sec/real(SecPerDay,R8) + + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call shr_cal_ymd2date(yr,mon,day,start_ymd) + start_tod = sec + time_units = 'days since '//trim(lilac_io_date2yyyymmdd(start_ymd))//' '//lilac_io_sec2hms(start_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call shr_cal_ymd2date(yr,mon,day,next_ymd) + next_tod = sec + + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call shr_cal_ymd2date(yr,mon,day,curr_ymd) + curr_tod = sec + + !--------------------------------------- + ! Write restart file + ! Use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for restart file names + !--------------------------------------- + + write(restart_file,"(5a)") trim(caseid),'.lilac','.r.', trim(nexttimestr),'.nc' + call ESMF_LogWrite(subname//"lilac restart file is "//trim(restart_file), ESMF_LOGMSG_INFO) + + if (mytask == 0) then + open(newunit=unitn, file="rpointer.lilac", form='FORMATTED') + write(unitn,'(a)') trim(restart_file) + close(unitn) + call ESMF_LogWrite(trim(subname)//" wrote lilac restart pointer file rpointer.lilac", ESMF_LOGMSG_INFO) + endif + + call ESMF_LogWrite(trim(subname)//": writing "//trim(restart_file), ESMF_LOGMSG_INFO) + call lilac_io_wopen(restart_file, vm, mytask, clobber=.true.) + + do m = 1,2 + if (m == 1) then + write_header = .true. ; write_data = .false. + else + write_header = .false. ; write_data = .true. + endif + + if (write_data) then + call lilac_io_enddef(restart_file) + end if + + call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO) + call lilac_io_write(restart_file, iam=mytask, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=write_header, wdata=write_data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Write out next ymd/tod in place of curr ymd/tod because + ! the currently the restart represents the time at end of + ! the current timestep and that is where we want to start the next run. + + call lilac_io_write(restart_file, mytask, next_ymd , 'curr_ymd' , whead=write_header, wdata=write_data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(restart_file, mytask, next_tod , 'curr_tod' , whead=write_header, wdata=write_data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call lilac_io_write(restart_file, mytask, start_ymd , 'start_ymd' , whead=write_header, wdata=write_data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(restart_file, mytask, start_tod , 'start_tod' , whead=write_header, wdata=write_data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + call lilac_io_close(restart_file, mytask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": closing "//trim(restart_file), ESMF_LOGMSG_INFO) + + end subroutine lilac_time_restart_write + + !=============================================================================== + + subroutine lilac_time_restart_read(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + + ! ------------------------------------------------- + ! Read the restart time info needed to initialize the clock + ! ------------------------------------------------- + + ! input/output variables + character(len=*), intent(in) :: restart_file + integer, intent(out) :: start_ymd ! Current ymd (YYYYMMDD) + integer, intent(out) :: start_tod ! Current tod (seconds) + integer, intent(out) :: curr_ymd ! Current ymd (YYYYMMDD) + integer, intent(out) :: curr_tod ! Current tod (seconds) + integer, intent(out) :: rc + + ! local variables + integer :: status, ncid, varid ! netcdf stuff + character(CL) :: tmpstr ! temporary + character(len=*), parameter :: subname = "(lilac_time_restart_read)" + !---------------------------------------------------------------- + + ! use netcdf here since it's serial + status = nf90_open(restart_file, NF90_NOWRITE, ncid) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_open') + + status = nf90_inq_varid(ncid, 'curr_ymd', varid) + if (status /= nf90_NoErr) call shr_sys_abort('ERROR: nf90_inq_varid curr_ymd') + status = nf90_get_var(ncid, varid, curr_ymd) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_ymd') + status = nf90_inq_varid(ncid, 'curr_tod', varid) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_inq_varid curr_tod') + status = nf90_get_var(ncid, varid, curr_tod) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_tod') + + status = nf90_inq_varid(ncid, 'start_ymd', varid) + if (status /= nf90_NoErr) call shr_sys_abort('ERROR: nf90_inq_varid start_ymd') + status = nf90_get_var(ncid, varid, start_ymd) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var start_ymd') + status = nf90_inq_varid(ncid, 'start_tod', varid) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_inq_varid start_tod') + status = nf90_get_var(ncid, varid, start_tod) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var start_tod') + + + status = nf90_close(ncid) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close') + + write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + end subroutine lilac_time_restart_read + +end module lilac_time diff --git a/lilac/stub_rof/rof_comp_esmf.F90 b/lilac/stub_rof/rof_comp_esmf.F90 new file mode 100644 index 0000000000..d708818e0d --- /dev/null +++ b/lilac/stub_rof/rof_comp_esmf.F90 @@ -0,0 +1,30 @@ +module rof_comp_esmf + + ! ------------------------------------------------------------------------ + ! This is a stub version of rof_comp_esmf that can be used when we don't have a true + ! rof component, just to satisfy the necessary interfaces in LILAC. + ! ------------------------------------------------------------------------ + + use ESMF + + implicit none + private + + public :: rof_register + +!=============================================================================== +contains +!=============================================================================== + + subroutine rof_register(comp, rc) + + ! Stub rof_register routine - shouldn't ever be called! + + ! input/output argumenents + type(ESMF_GridComp) :: comp ! ROF grid component + integer, intent(out) :: rc ! return status + + rc = ESMF_RC_NOT_IMPL + end subroutine rof_register + +end module rof_comp_esmf diff --git a/lilac/tests/CMakeLists.txt b/lilac/tests/CMakeLists.txt new file mode 100644 index 0000000000..09a90942c8 --- /dev/null +++ b/lilac/tests/CMakeLists.txt @@ -0,0 +1,2 @@ +# Add tests here +target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/python/Makefile b/python/Makefile index e4e39d2b5b..470d32b9d4 100644 --- a/python/Makefile +++ b/python/Makefile @@ -6,9 +6,9 @@ verbose = not-set debug = not-set ifneq ($(python), not-set) -PYTHON=$(python) + PYTHON=$(python) else -PYTHON=python + PYTHON=python endif ifneq ($(debug), not-set) @@ -23,9 +23,16 @@ PYLINT_ARGS=-j 4 --rcfile=ctsm/.pylintrc PYLINT_SRC = \ ctsm -.PHONY: test -test: FORCE - $(PYTHON) ./run_ctsm_py_tests $(TEST_ARGS) +all: test lint +test: utest stest + +.PHONY: utest +utest: FORCE + $(PYTHON) ./run_ctsm_py_tests $(TEST_ARGS) --unit + +.PHONY: stest +stest: FORCE + $(PYTHON) ./run_ctsm_py_tests $(TEST_ARGS) --sys .PHONY: lint lint: FORCE diff --git a/python/README.md b/python/README.md index 8b265d3290..c1cd00e4aa 100644 --- a/python/README.md +++ b/python/README.md @@ -1,9 +1,14 @@ # Testing the code here -## Unit tests +## Running everything -Unit tests can be run in one of two ways; these do the same thing, but -support different options: +To run all tests (unit tests, system tests and pylint), simply run `make +all` from this directory. + +## 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` @@ -12,12 +17,16 @@ support different options: - python version: `make python=python3 test` - 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_ctsm_py_tests` You can specify various arguments to this; run `./run_ctsm_py_tests -h` for details - + ## pylint You can run pylint on everything in the ctsm package with `make lint`. diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py new file mode 100644 index 0000000000..967542f356 --- /dev/null +++ b/python/ctsm/lilac_build_ctsm.py @@ -0,0 +1,712 @@ +"""Functions implementing LILAC's build_ctsm command""" + +import argparse +import logging +import os +import shutil +import subprocess + +from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args +from ctsm.os_utils import run_cmd_output_on_error, make_link +from ctsm.path_utils import path_to_ctsm_root +from ctsm.utils import abort, fill_template_file + +logger = logging.getLogger(__name__) + +# ======================================================================== +# Define some constants +# ======================================================================== + +# this matches the machine name in config_machines_template.xml +_MACH_NAME = 'ctsm_build' + +# these are arbitrary, since we only use the case for its build, not any of the runtime +# settings; they just need to be valid +_COMPSET = 'I2000Ctsm50NwpSpAsRsGs' +_RES = 'f10_f10_musgs' + +_PATH_TO_TEMPLATES = os.path.join(path_to_ctsm_root(), + 'lilac', + 'bld_templates') + +_PATH_TO_MAKE_RUNTIME_INPUTS = os.path.join(path_to_ctsm_root(), + 'lilac', + 'make_runtime_inputs') + +_PATH_TO_DOWNLOAD_INPUT_DATA = os.path.join(path_to_ctsm_root(), + 'lilac', + 'download_input_data') + +_MACHINE_CONFIG_DIRNAME = 'machine_configuration' +_INPUTDATA_DIRNAME = 'inputdata' +_RUNTIME_INPUTS_DIRNAME = 'runtime_inputs' + +_GPTL_NANOTIMERS_CPPDEFS = '-DHAVE_NANOTIME -DBIT64 -DHAVE_VPRINTF -DHAVE_BACKTRACE -DHAVE_SLASHPROC -DHAVE_COMM_F2C -DHAVE_TIMES -DHAVE_GETTIMEOFDAY' # pylint: disable=line-too-long + +# ======================================================================== +# Public functions +# ======================================================================== + +def main(cime_path): + """Main function called when build_ctsm is run from the command-line + + Args: + cime_path (str): path to the cime that we're using (this is passed in explicitly + rather than relying on calling path_to_cime so that we can be absolutely sure that + the scripts called here are coming from the same cime as the cime library we're + using). + """ + setup_logging_pre_config() + args = _commandline_args() + process_logging_args(args) + build_dir = os.path.abspath(args.build_dir) + + if args.rebuild: + rebuild_ctsm(build_dir=build_dir) + else: + build_ctsm(cime_path=cime_path, + build_dir=build_dir, + compiler=args.compiler, + no_build=args.no_build, + machine=args.machine, + os_type=args.os, + netcdf_path=args.netcdf_path, + esmf_lib_path=args.esmf_lib_path, + max_mpitasks_per_node=args.max_mpitasks_per_node, + gmake=args.gmake, + gmake_j=args.gmake_j, + pnetcdf_path=args.pnetcdf_path, + pio_filesystem_hints=args.pio_filesystem_hints, + gptl_nano_timers=args.gptl_nano_timers, + extra_fflags=args.extra_fflags, + extra_cflags=args.extra_cflags, + no_pnetcdf=args.no_pnetcdf, + build_debug=args.build_debug, + build_with_openmp=args.build_with_openmp, + inputdata_path=args.inputdata_path) + +def build_ctsm(cime_path, + build_dir, + compiler, + no_build=False, + machine=None, + os_type=None, + netcdf_path=None, + esmf_lib_path=None, + max_mpitasks_per_node=None, + gmake=None, + gmake_j=None, + pnetcdf_path=None, + pio_filesystem_hints=None, + gptl_nano_timers=False, + extra_fflags='', + extra_cflags='', + no_pnetcdf=False, + build_debug=False, + build_with_openmp=False, + inputdata_path=None): + """Implementation of build_ctsm command + + Args: + cime_path (str): path to root of cime + build_dir (str): path to build directory + compiler (str): compiler type + no_build (bool): If True, set things up, but skip doing the actual build + machine (str or None): machine name (a machine known to cime) + os_type (str or None): operating system type; one of linux, aix, darwin or cnl + Must be given if machine isn't given; ignored if machine is given + netcdf_path (str or None): path to NetCDF installation + Must be given if machine isn't given; ignored if machine is given + esmf_lib_path (str or None): path to ESMF library directory + Must be given if machine isn't given; ignored if machine is given + max_mpitasks_per_node (int or None): number of physical processors per shared-memory node + Must be given if machine isn't given; ignored if machine is given + gmake (str or None): name of GNU make tool + Must be given if machine isn't given; ignored if machine is given + gmake_j (int or None): number of threads to use when building + Must be given if machine isn't given; ignored if machine is given + pnetcdf_path (str or None): path to PNetCDF installation, if present (or None) + Ignored if machine is given + pio_filesystem_hints (str or None): if present (not None), enable filesystem hints for the + given filesystem type + Ignored if machine is given + gptl_nano_timers (bool): if True, enable timers in build of the GPTL timing library + Ignored if machine is given + extra_fflags (str): any extra flags to include when compiling Fortran files + Ignored if machine is given + extra_cflags (str): any extra flags to include when compiling C files + Ignored if machine is given + no_pnetcdf (bool): if True, use netcdf rather than pnetcdf + build_debug (bool): if True, build with flags for debugging + build_with_openmp (bool): if True, build with OpenMP support + inputdata_path (str or None): path to existing inputdata directory on this machine + If None, an inputdata directory will be created for this build + (If machine is given, then we use the machine's inputdata directory by default; + but if inputdata_path is given, it overrides the machine's inputdata directory.) + """ + + existing_machine = machine is not None + existing_inputdata = existing_machine or inputdata_path is not None + _create_build_dir(build_dir=build_dir, + existing_inputdata=existing_inputdata) + + if machine is None: + assert os_type is not None, 'with machine absent, os_type must be given' + assert netcdf_path is not None, 'with machine absent, netcdf_path must be given' + assert esmf_lib_path is not None, 'with machine absent, esmf_lib_path must be given' + assert max_mpitasks_per_node is not None, ('with machine absent ' + 'max_mpitasks_per_node must be given') + os_type = _check_and_transform_os(os_type) + _fill_out_machine_files(build_dir=build_dir, + os_type=os_type, + compiler=compiler, + netcdf_path=netcdf_path, + esmf_lib_path=esmf_lib_path, + max_mpitasks_per_node=max_mpitasks_per_node, + gmake=gmake, + gmake_j=gmake_j, + pnetcdf_path=pnetcdf_path, + pio_filesystem_hints=pio_filesystem_hints, + gptl_nano_timers=gptl_nano_timers, + extra_fflags=extra_fflags, + extra_cflags=extra_cflags) + + _create_case(cime_path=cime_path, + build_dir=build_dir, + compiler=compiler, + machine=machine, + build_debug=build_debug, + build_with_openmp=build_with_openmp, + inputdata_path=inputdata_path) + + _stage_runtime_inputs(build_dir=build_dir, no_pnetcdf=no_pnetcdf) + + print('Initial setup complete; it is now safe to work with the runtime inputs in\n' + '{}\n'.format(os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME))) + + if not no_build: + _build_case(build_dir=build_dir) + +def rebuild_ctsm(build_dir): + """Re-run the build in an existing directory + + Args: + build_dir (str): path to build directory + """ + if not os.path.exists(build_dir): + abort('When running with --rebuild, the build directory must already exist\n' + '(<{}> does not exist)'.format(build_dir)) + + case_dir = _get_case_dir(build_dir) + if not os.path.exists(case_dir): + abort('It appears there was a problem setting up the initial build in\n' + '<{}>\n' + 'You should start over with a fresh build directory.'.format(build_dir)) + + try: + subprocess.check_call( + [os.path.join(case_dir, 'case.build'), + '--clean-depends', + 'lnd'], + cwd=case_dir) + except subprocess.CalledProcessError: + abort('ERROR resetting build for CTSM in order to rebuild - see above for details') + + _build_case(build_dir) + +# ======================================================================== +# Private functions +# ======================================================================== + +def _commandline_args(args_to_parse=None): + """Parse and return command-line arguments + + Args: + args_to_parse: list of strings or None: Generally only used for unit testing; if None, + reads args from sys.argv + """ + # pylint: disable=line-too-long + # pylint: disable=too-many-statements + + description = """ +Script to build CTSM library and its dependencies + +Typical usage: + + For a fresh build with a machine that has been ported to cime + (http://esmci.github.io/cime/versions/master/html/users_guide/porting-cime.html): + + build_ctsm /path/to/nonexistent/directory --machine MACHINE --compiler COMPILER + + (Some other optional arguments are also allowed in this usage, but many are not.) + + For a fresh build with a machine that has NOT been ported to cime: + + build_ctsm /path/to/nonexistent/directory --os OS --compiler COMPILER --netcdf-path NETCDF_PATH --esmf-lib-path ESMF_LIB_PATH --max-mpitasks-per-node MAX_MPITASKS_PER_NODE --pnetcdf-path PNETCDF_PATH + + If PNetCDF is not available, set --no-pnetcdf instead of --pnetcdf-path. + + (Other optional arguments are also allowed in this usage.) + + For rebuilding: + + build_ctsm /path/to/existing/directory --rebuild + + (Most other arguments are NOT allowed in this usage.) +""" + + parser = argparse.ArgumentParser( + description=description, + formatter_class=argparse.RawTextHelpFormatter) + + parser.add_argument('build_dir', + help='Path to build directory\n' + 'If --rebuild is given, this should be the path to an existing build,\n' + 'otherwise this directory must not already exist.') + + main_opts = parser.add_mutually_exclusive_group() + + main_opts.add_argument('--machine', + help='Name of machine; this must be a machine that has been ported to cime\n' + '(http://esmci.github.io/cime/versions/master/html/users_guide/porting-cime.html)\n' + 'If given, then none of the machine-definition optional arguments should be given.\n') + + main_opts.add_argument('--rebuild', action='store_true', + help='Rebuild in an existing build directory\n' + 'If given, none of the machine-definition or build-related optional arguments\n' + 'should be given.\n') + + non_rebuild_required = parser.add_argument_group( + title='required arguments when not rebuilding', + description='These arguments are required if --rebuild is not given; ' + 'they are not allowed with --rebuild:') + non_rebuild_required_list = [] + + # For now, only support the compilers that we regularly test with, even though cime + # supports many other options + non_rebuild_required.add_argument('--compiler', type=str.lower, + choices=['gnu', 'intel', 'nag', 'pgi'], + help='Compiler type') + non_rebuild_required_list.append('compiler') + + non_rebuild_optional = parser.add_argument_group( + title='optional arguments when not rebuilding', + description='These arguments are optional if --rebuild is not given; ' + 'they are not allowed with --rebuild:') + non_rebuild_optional_list = [] + + non_rebuild_optional.add_argument('--no-pnetcdf', action='store_true', + help='Use NetCDF instead of PNetCDF for CTSM I/O.\n' + 'On a user-defined machine, you must either set this flag\n' + 'or set --pnetcdf-path. On a cime-ported machine,\n' + 'this flag must be set if PNetCDF is not available\n' + 'for this machine/compiler.') + non_rebuild_optional_list.append('no-pnetcdf') + + non_rebuild_optional.add_argument('--build-debug', action='store_true', + help='Build with flags for debugging rather than production runs') + non_rebuild_optional_list.append('build-debug') + + non_rebuild_optional.add_argument('--build-with-openmp', action='store_true', + help='By default, CTSM is built WITHOUT support for OpenMP threading;\n' + 'if this flag is set, then CTSM is built WITH this support.\n' + 'This is important for performance if you will be running with\n' + 'OpenMP threading-based parallelization, or hybrid MPI/OpenMP.') + non_rebuild_optional_list.append('build-with-openmp') + + non_rebuild_optional.add_argument('--inputdata-path', + help='Path to directory containing CTSM\'s NetCDF inputs.\n' + 'For a machine that has been ported to cime, the default is to\n' + 'use this machine\'s standard inputdata location; this argument\n' + 'can be used to override this default.\n' + 'For a user-defined machine, the default is to create an inputdata\n' + 'directory in the build directory; again, this argument can be\n' + 'used to override this default.') + non_rebuild_optional_list.append('inputdata-path') + + non_rebuild_optional.add_argument('--no-build', action='store_true', + help='Do the pre-build setup, but do not actually build CTSM\n' + '(This is useful for testing, or for expert use.)') + non_rebuild_optional_list.append('no-build') + + new_machine_required = parser.add_argument_group( + title='required arguments for a user-defined machine', + description='These arguments are required if neither --machine nor --rebuild are given; ' + 'they are not allowed with either of those arguments:') + new_machine_required_list = [] + + new_machine_required.add_argument('--os', type=str.lower, + choices=['linux', 'aix', 'darwin', 'cnl'], + help='Operating system type') + new_machine_required_list.append('os') + + new_machine_required.add_argument('--netcdf-path', + help='Path to NetCDF installation\n' + '(path to top-level directory, containing subdirectories\n' + 'named lib, include, etc.)') + new_machine_required_list.append('netcdf-path') + + new_machine_required.add_argument('--esmf-lib-path', + help='Path to ESMF library directory\n' + 'This directory should include an esmf.mk file') + new_machine_required_list.append('esmf-lib-path') + + new_machine_required.add_argument('--max-mpitasks-per-node', type=int, + help='Number of physical processors per shared-memory node\n' + 'on this machine') + new_machine_required_list.append('max-mpitasks-per-node') + + new_machine_optional = parser.add_argument_group( + title='optional arguments for a user-defined machine', + description='These arguments are optional if neither --machine nor --rebuild are given; ' + 'they are not allowed with either of those arguments:') + new_machine_optional_list = [] + + new_machine_optional.add_argument('--gmake', default='gmake', + help='Name of GNU Make tool on your system\n' + 'Default: gmake') + new_machine_optional_list.append('gmake') + + new_machine_optional.add_argument('--gmake-j', default=8, type=int, + help='Number of threads to use when building\n' + 'Default: 8') + new_machine_optional_list.append('gmake-j') + + new_machine_optional.add_argument('--pnetcdf-path', + help='Path to PNetCDF installation, if present\n' + 'You must either specify this or set --no-pnetcdf') + new_machine_optional_list.append('pnetcdf-path') + + new_machine_optional.add_argument('--pio-filesystem-hints', type=str.lower, + choices=['gpfs', 'lustre'], + help='Enable filesystem hints for the given filesystem type\n' + 'when building the Parallel IO library') + new_machine_optional_list.append('pio-filesystem-hints') + + new_machine_optional.add_argument('--gptl-nano-timers', action='store_true', + help='Enable nano timers in build of the GPTL timing library') + new_machine_optional_list.append('gptl-nano-timers') + + new_machine_optional.add_argument('--extra-fflags', default='', + help='Any extra, non-standard flags to include\n' + 'when compiling Fortran files\n' + 'Tip: to allow a dash at the start of these flags,\n' + 'use a quoted string with an initial space, as in:\n' + ' --extra-fflags " -flag1 -flag2"') + new_machine_optional_list.append('extra-fflags') + + new_machine_optional.add_argument('--extra-cflags', default='', + help='Any extra, non-standard flags to include\n' + 'when compiling C files\n' + 'Tip: to allow a dash at the start of these flags,\n' + 'use a quoted string with an initial space, as in:\n' + ' --extra-cflags " -flag1 -flag2"') + new_machine_optional_list.append('extra-cflags') + + add_logging_args(parser) + + args = parser.parse_args(args_to_parse) + if args.rebuild: + _confirm_args_absent(parser, args, "cannot be provided if --rebuild is set", + (non_rebuild_required_list + non_rebuild_optional_list + + new_machine_required_list + new_machine_optional_list)) + else: + _confirm_args_present(parser, args, "must be provided if --rebuild is not set", + non_rebuild_required_list) + if args.machine: + _confirm_args_absent(parser, args, "cannot be provided if --machine is set", + new_machine_required_list + new_machine_optional_list) + else: + _confirm_args_present(parser, args, "must be provided if neither --machine nor --rebuild are set", + new_machine_required_list) + if not args.no_pnetcdf and args.pnetcdf_path is None: + parser.error("For a user-defined machine, need to specify either --no-pnetcdf or --pnetcdf-path") + if args.no_pnetcdf and args.pnetcdf_path is not None: + parser.error("--no-pnetcdf cannot be given if you set --pnetcdf-path") + + return args + +def _confirm_args_absent(parser, args, errmsg, args_not_allowed): + """Confirms that all args not allowed in this usage are absent + + Calls parser.error if there are problems + + Args: + parser: ArgumentParser + args: list of parsed arguments + errmsg: string - message printed if there is a problem + args_not_allowed: list of strings - argument names in this category + """ + for arg in args_not_allowed: + arg_no_dashes = arg.replace('-', '_') + # To determine whether the user specified an argument, we look at whether its + # value differs from its default value. This won't catch the case where the user + # explicitly set an argument to its default value, but it's not a big deal if we + # miss printing an error in that case. + if vars(args)[arg_no_dashes] != parser.get_default(arg_no_dashes): + parser.error('--{} {}'.format(arg, errmsg)) + +def _confirm_args_present(parser, args, errmsg, args_required): + """Confirms that all args required in this usage are present + + Calls parser.error if there are problems + + Args: + parser: ArgumentParser + args: list of parsed arguments + errmsg: string - message printed if there is a problem + args_required: list of strings - argument names in this category + """ + for arg in args_required: + arg_no_dashes = arg.replace('-', '_') + if vars(args)[arg_no_dashes] is None: + parser.error('--{} {}'.format(arg, errmsg)) + +def _check_and_transform_os(os_type): + """Check validity of os_type argument and transform it to proper case + + os_type should be a lowercase string; returns a transformed string + """ + transforms = {'linux': 'LINUX', + 'aix': 'AIX', + 'darwin': 'Darwin', + 'cnl': 'CNL'} + try: + os_type_transformed = transforms[os_type] + except KeyError: + raise ValueError("Unknown OS: {}".format(os_type)) + return os_type_transformed + +def _get_case_dir(build_dir): + """Given the path to build_dir, return the path to the case directory""" + return os.path.join(build_dir, 'case') + +def _create_build_dir(build_dir, existing_inputdata): + """Create the given build directory and any necessary sub-directories + + Args: + build_dir (str): path to build directory; this directory shouldn't exist yet! + existing_inputdata (bool): whether the inputdata directory already exists on this machine + """ + if os.path.exists(build_dir): + abort('When running without --rebuild, the build directory must not exist yet\n' + '(<{}> already exists)'.format(build_dir)) + os.makedirs(build_dir) + if not existing_inputdata: + os.makedirs(os.path.join(build_dir, _INPUTDATA_DIRNAME)) + +def _fill_out_machine_files(build_dir, + os_type, + compiler, + netcdf_path, + esmf_lib_path, + max_mpitasks_per_node, + gmake, + gmake_j, + pnetcdf_path=None, + pio_filesystem_hints=None, + gptl_nano_timers=False, + extra_fflags='', + extra_cflags=''): + """Fill out the machine porting templates for this machine / compiler + + For documentation of args, see the documentation in the build_ctsm function + """ + os.makedirs(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)) + + # ------------------------------------------------------------------------ + # Fill in config_machines.xml + # ------------------------------------------------------------------------ + + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'config_machines_template.xml'), + path_to_final=os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_machines.xml'), + substitutions={'OS':os_type, + 'COMPILER':compiler, + 'CIME_OUTPUT_ROOT':build_dir, + 'GMAKE':gmake, + 'GMAKE_J':gmake_j, + 'MAX_MPITASKS_PER_NODE':max_mpitasks_per_node}) + + # ------------------------------------------------------------------------ + # Fill in config_compilers.xml + # ------------------------------------------------------------------------ + + if gptl_nano_timers: + gptl_cppdefs = _GPTL_NANOTIMERS_CPPDEFS + else: + gptl_cppdefs = '' + + if pio_filesystem_hints: + pio_filesystem_hints_tag = '{}'.format( + pio_filesystem_hints) + else: + pio_filesystem_hints_tag = '' + + if pnetcdf_path: + pnetcdf_path_tag = '{}'.format( + pnetcdf_path) + else: + pnetcdf_path_tag = '' + + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, + 'config_compilers_template.xml'), + path_to_final=os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_compilers.xml'), + substitutions={'COMPILER':compiler, + 'GPTL_CPPDEFS':gptl_cppdefs, + 'NETCDF_PATH':netcdf_path, + 'PIO_FILESYSTEM_HINTS':pio_filesystem_hints_tag, + 'PNETCDF_PATH':pnetcdf_path_tag, + 'ESMF_LIBDIR':esmf_lib_path, + 'EXTRA_CFLAGS':extra_cflags, + 'EXTRA_FFLAGS':extra_fflags}) + + +def _create_case(cime_path, build_dir, compiler, + machine=None, build_debug=False, build_with_openmp=False, + inputdata_path=None): + """Create a case that can later be used to build the CTSM library and its dependencies + + Args: + cime_path (str): path to root of cime + build_dir (str): path to build directory + compiler (str): compiler to use + machine (str or None): name of machine or None + If None, we assume we're using an on-the-fly machine port + Otherwise, machine should be the name of a machine known to cime + build_debug (bool): if True, build with flags for debugging + build_with_openmp (bool): if True, build with OpenMP support + inputdata_path (str or None): path to existing inputdata directory on this machine + If None, we use the machine's default DIN_LOC_ROOT + """ + # Note that, for some commands, we want to suppress output, only showing the output if + # the command fails; for these we use run_cmd_output_on_error. For other commands, + # there should be no output in general; for these, we directly use + # subprocess.check_call or similar. + + # Also note that, for commands executed from the case directory, we specify the path + # to the case directory both in the command itself and in the cwd argument. We do the + # former in case dot isn't in the user's path; we do the latter in case the commands + # require you to be in the case directory when you execute them. + + case_dir = _get_case_dir(build_dir) + xmlchange = os.path.join(case_dir, 'xmlchange') + + if machine is None: + machine_args = ['--machine', _MACH_NAME, + '--extra-machines-dir', os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)] + else: + machine_args = ['--machine', machine] + + create_newcase_cmd = [os.path.join(cime_path, 'scripts', 'create_newcase'), + '--output-root', build_dir, + '--case', case_dir, + '--compset', _COMPSET, + '--res', _RES, + '--compiler', compiler, + '--driver', 'nuopc', + '--run-unsupported'] + create_newcase_cmd.extend(machine_args) + if inputdata_path: + create_newcase_cmd.extend(['--input-dir', inputdata_path]) + run_cmd_output_on_error(create_newcase_cmd, + errmsg='Problem creating CTSM case directory') + + # PIO2 sometimes causes errors: see + # https://github.com/ESCOMP/CTSM/issues/876#issuecomment-653189406 and following + # comments in that issue. So use PIO1 for now. + subprocess.check_call([xmlchange, 'PIO_VERSION=1'], cwd=case_dir) + + subprocess.check_call([xmlchange, 'LILAC_MODE=on'], cwd=case_dir) + if build_debug: + subprocess.check_call([xmlchange, 'DEBUG=TRUE'], cwd=case_dir) + if build_with_openmp: + subprocess.check_call([xmlchange, 'FORCE_BUILD_SMP=TRUE'], cwd=case_dir) + + run_cmd_output_on_error([os.path.join(case_dir, 'case.setup')], + errmsg='Problem setting up CTSM case directory', + cwd=case_dir) + + make_link(os.path.join(case_dir, 'bld'), + os.path.join(build_dir, 'bld')) + if machine is not None: + # For a pre-existing machine, the .env_mach_specific files are likely useful to + # the user. Make sym links to these with more intuitive names. + for extension in ('sh', 'csh'): + make_link(os.path.join(case_dir, '.env_mach_specific.{}'.format(extension)), + os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) + +def _stage_runtime_inputs(build_dir, no_pnetcdf): + """Stage CTSM and LILAC runtime inputs + + Args: + build_dir (str): path to build directory + no_pnetcdf (bool): if True, use netcdf rather than pnetcdf + """ + os.makedirs(os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME)) + + inputdata_dir = _xmlquery('DIN_LOC_ROOT', build_dir) + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'ctsm_template.cfg'), + path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'ctsm.cfg'), + substitutions={'INPUTDATA':inputdata_dir}) + + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'lilac_in_template'), + path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lilac_in'), + substitutions={'INPUTDATA':inputdata_dir}) + + pio_stride = _xmlquery('MAX_MPITASKS_PER_NODE', build_dir) + if no_pnetcdf: + pio_typename = 'netcdf' + else: + pio_typename = 'pnetcdf' + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'lnd_modelio_template.nml'), + path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lnd_modelio.nml'), + substitutions={'PIO_STRIDE':pio_stride, + 'PIO_TYPENAME':pio_typename}) + + shutil.copyfile( + src=os.path.join(path_to_ctsm_root(), + 'cime_config', 'usermods_dirs', 'lilac', 'user_nl_ctsm'), + dst=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'user_nl_ctsm')) + + make_link(_PATH_TO_MAKE_RUNTIME_INPUTS, + os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'make_runtime_inputs')) + + make_link(_PATH_TO_DOWNLOAD_INPUT_DATA, + os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'download_input_data')) + +def _build_case(build_dir): + """Build the CTSM library and its dependencies + + Args: + build_dir (str): path to build directory + """ + # We want user to see output from the build command, so we use subprocess.check_call + # rather than run_cmd_output_on_error. + + # See comment in _create_case for why we use case_dir in both the path to the command + # and in the cwd argument to check_call. + case_dir = _get_case_dir(build_dir) + try: + subprocess.check_call( + [os.path.join(case_dir, 'case.build'), + '--sharedlib-only'], + cwd=case_dir) + except subprocess.CalledProcessError: + abort('ERROR building CTSM or its dependencies - see above for details') + + make_link(os.path.join(case_dir, 'bld', 'ctsm.mk'), + os.path.join(build_dir, 'ctsm.mk')) + +def _xmlquery(varname, build_dir): + """Run xmlquery from the case in build_dir and return the value of the given variable""" + case_dir = _get_case_dir(build_dir) + xmlquery_path = os.path.join(case_dir, 'xmlquery') + value = subprocess.check_output([xmlquery_path, '--value', varname], + cwd=case_dir, + universal_newlines=True) + return value diff --git a/python/ctsm/lilac_download_input_data.py b/python/ctsm/lilac_download_input_data.py new file mode 100644 index 0000000000..1e0c240d25 --- /dev/null +++ b/python/ctsm/lilac_download_input_data.py @@ -0,0 +1,86 @@ +"""Functions implementing LILAC's download_input_data command""" + +import argparse +import logging +import os +import re + +from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args + +from CIME.case import Case # pylint: disable=import-error + +logger = logging.getLogger(__name__) + +# ======================================================================== +# Define some constants +# ======================================================================== + +# In lilac_in, file names match this pattern: The variable name ends with 'filename', so +# that is the last thing before the equals sign on the line. +_LILAC_FILENAME = r"filename *=" + +# ======================================================================== +# Public functions +# ======================================================================== + +def main(): + """Main function called when download_input_data is run from the command-line + """ + setup_logging_pre_config() + args = _commandline_args() + process_logging_args(args) + + download_input_data(rundir=args.rundir) + +def download_input_data(rundir): + """Implementation of the download_input_data command + + Args: + rundir: str - path to directory containing input_data_list files + """ + _create_lilac_input_data_list(rundir) + case = Case(os.path.realpath(os.path.join(rundir, os.pardir, 'case'))) + case.check_all_input_data( + data_list_dir=rundir, + download=True, + chksum=False) + os.remove(os.path.join(rundir, 'lilac.input_data_list')) + +# ======================================================================== +# Private functions +# ======================================================================== + +def _commandline_args(): + """Parse and return command-line arguments + """ + + description = """ +Script to download any missing input data for CTSM and LILAC +""" + + parser = argparse.ArgumentParser( + description=description, + formatter_class=argparse.RawTextHelpFormatter) + + parser.add_argument("--rundir", default=os.getcwd(), + help="Full path of the run directory\n" + "(This directory should contain clm.input_data_list and lilac_in,\n" + "among other files.)\n" + "(Note: it is assumed that this directory exists alongside the other\n" + "directories created by build_ctsm: 'case' and 'inputdata'.)") + + add_logging_args(parser) + + args = parser.parse_args() + + return args + +def _create_lilac_input_data_list(rundir): + with open(os.path.join(rundir, 'lilac_in')) as lilac_in: + with open(os.path.join(rundir, 'lilac.input_data_list'), 'w') as input_data_list: + for line in lilac_in: + if re.search(_LILAC_FILENAME, line): + # Remove quotes from filename, then output this line + line = line.replace('"', '') + line = line.replace("'", "") + input_data_list.write(line) diff --git a/python/ctsm/lilac_make_runtime_inputs.py b/python/ctsm/lilac_make_runtime_inputs.py new file mode 100644 index 0000000000..bfe4998c02 --- /dev/null +++ b/python/ctsm/lilac_make_runtime_inputs.py @@ -0,0 +1,297 @@ +"""Functions implementing LILAC's make_runtime_inputs command""" + +import os +import subprocess +import argparse +import logging + +from configparser import ConfigParser +from configparser import NoSectionError, NoOptionError + +from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args +from ctsm.path_utils import path_to_ctsm_root +from ctsm.utils import abort + +from CIME.buildnml import create_namelist_infile # pylint: disable=import-error + +logger = logging.getLogger(__name__) + +# ======================================================================== +# Define some constants +# ======================================================================== + +_CONFIG_CACHE_TEMPLATE = """ + + + +Specifies clm physics + +""" + +# Note the following is needed in env_lilac.xml otherwise the following error appears in +# the call to build_namelist + +#err=ERROR : CLM build-namelist::CLMBuildNamelist::logical_to_fortran() : +# Unexpected value in logical_to_fortran: + +_ENV_LILAC_TEMPLATE = """ + + + + + logical + TRUE,FALSE + + + +""" + +# This string is used in the out-of-the-box ctsm.cfg file to denote a value that needs to +# be filled in +_PLACEHOLDER = 'FILL_THIS_IN' + +# This string is used in the out-of-the-box ctsm.cfg file to denote a value that can be +# filled in, but doesn't absolutely need to be +_UNSET = 'UNSET' + +# ======================================================================== +# Fake case class that can be used to satisfy the interface of CIME functions that need a +# case object +# ======================================================================== + +class CaseFake: + """Fake case class to satisfy interface of CIME functions that need a case object""" + # pylint: disable=too-few-public-methods + + def __init__(self): + pass + + @staticmethod + def get_resolved_value(value): + """Make sure get_resolved_value doesn't get called + + (since we don't have a real case object to resolve values with) + """ + abort("Cannot resolve value with a '$' variable: {}".format(value)) + +############################################################################### +def parse_command_line(): +############################################################################### + + """Parse the command line, return object holding arguments""" + + description = """ +Script to create runtime inputs when running CTSM via LILAC +""" + + parser = argparse.ArgumentParser(formatter_class=argparse.RawTextHelpFormatter, + description=description) + + parser.add_argument("--rundir", type=str, default=os.getcwd(), + help="Full path of the run directory (containing ctsm.cfg & user_nl_ctsm)") + + add_logging_args(parser) + + arguments = parser.parse_args() + + # Perform some error checking on arguments + + if not os.path.isdir(arguments.rundir): + abort("rundir {} does not exist".format(arguments.rundir)) + + return arguments + +############################################################################### +def get_config_value(config, section, item, file_path, allowed_values=None): + """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 + """ + try: + val = config.get(section, item) + except NoSectionError: + abort("ERROR: Config file {} must contain section '{}'".format(file_path, section)) + except NoOptionError: + abort("ERROR: Config file {} must contain item '{}' in section '{}'".format( + file_path, item, section)) + + if val == _PLACEHOLDER: + abort("Error: {} needs to be specified in config file {}".format(item, file_path)) + + if allowed_values is not None: + if val not in allowed_values: + abort("Error: {} is not an allowed value for {} in config file {}\n" + "Allowed values: {}".format(val, item, file_path, allowed_values)) + + return val + +############################################################################### +def determine_bldnml_opts(bgc_mode, crop, vichydro): +############################################################################### + """Return a string giving bldnml options, given some other inputs""" + bldnml_opts = '' + bldnml_opts += ' -bgc {}'.format(bgc_mode) + if bgc_mode == 'fates': + # BUG(wjs, 2020-06-12, ESCOMP/CTSM#115) For now, FATES is incompatible with MEGAN + bldnml_opts += ' -no-megan' + + if crop == 'on': + if bgc_mode not in ['bgc', 'cn']: + abort("Error: setting crop to 'on' is only compatible with bgc_mode of 'bgc' or 'cn'") + bldnml_opts += ' -crop' + + if vichydro == 'on': + if bgc_mode != 'sp': + abort("Error: setting vichydro to 'on' is only compatible with bgc_mode of 'sp'") + bldnml_opts += ' -vichydro' + + return bldnml_opts + +############################################################################### +def buildnml(cime_path, rundir): +############################################################################### + + """Build the ctsm namelist + """ + + # pylint: disable=too-many-locals + # pylint: disable=too-many-statements + + ctsm_cfg_path = os.path.join(rundir, 'ctsm.cfg') + + # read the config file + config = ConfigParser() + config.read(ctsm_cfg_path) + + lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', ctsm_cfg_path) + fsurdat = get_config_value(config, 'buildnml_input', 'fsurdat', ctsm_cfg_path) + finidat = get_config_value(config, 'buildnml_input', 'finidat', ctsm_cfg_path) + + ctsm_phys = get_config_value(config, 'buildnml_input', 'ctsm_phys', ctsm_cfg_path, + allowed_values=['clm4_5', 'clm5_0']) + configuration = get_config_value(config, 'buildnml_input', 'configuration', ctsm_cfg_path, + allowed_values=['nwp', 'clm']) + structure = get_config_value(config, 'buildnml_input', 'structure', ctsm_cfg_path, + allowed_values=['fast', 'standard']) + bgc_mode = get_config_value(config, 'buildnml_input', 'bgc_mode', ctsm_cfg_path, + allowed_values=['sp', 'bgc', 'cn', 'fates']) + crop = get_config_value(config, 'buildnml_input', 'crop', ctsm_cfg_path, + allowed_values=['off', 'on']) + vichydro = get_config_value(config, 'buildnml_input', 'vichydro', ctsm_cfg_path, + allowed_values=['off', 'on']) + + bldnml_opts = determine_bldnml_opts(bgc_mode=bgc_mode, + crop=crop, + vichydro=vichydro) + + co2_ppmv = get_config_value(config, 'buildnml_input', 'co2_ppmv', ctsm_cfg_path) + use_case = get_config_value(config, 'buildnml_input', 'use_case', ctsm_cfg_path) + lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', ctsm_cfg_path) + spinup = get_config_value(config, 'buildnml_input', 'spinup', ctsm_cfg_path, + allowed_values=['off', 'on']) + + inputdata_path = get_config_value(config, 'buildnml_input', 'inputdata_path', ctsm_cfg_path) + + # Parse the user_nl_ctsm file + infile = os.path.join(rundir, '.namelist') + create_namelist_infile(case=CaseFake(), + user_nl_file=os.path.join(rundir, 'user_nl_ctsm'), + namelist_infile=infile) + + # 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 + config_cache = os.path.join(rundir, "config_cache.xml") + config_cache_text = _CONFIG_CACHE_TEMPLATE.format(clm_phys=ctsm_phys) + with open(config_cache, 'w') as tempfile: + tempfile.write(config_cache_text) + + # create temporary env_lilac.xml + env_lilac = os.path.join(rundir, "env_lilac.xml") + env_lilac_text = _ENV_LILAC_TEMPLATE.format() + with open(env_lilac, 'w') as tempfile: + tempfile.write(env_lilac_text) + + # remove any existing clm.input_data_list file + inputdatalist_path = os.path.join(rundir, "clm.input_data_list") + if os.path.exists(inputdatalist_path): + os.remove(inputdatalist_path) + + # determine if fsurdat and/or finidat should appear in the -namelist option + extra_namelist_opts = '' + if fsurdat != _UNSET: + # NOTE(wjs, 2020-06-30) With the current logic, fsurdat should never be _UNSET, + # but it's possible that this will change in the future. + extra_namelist_opts = extra_namelist_opts + " fsurdat = '{}' ".format(fsurdat) + if finidat != _UNSET: + extra_namelist_opts = extra_namelist_opts + " finidat = '{}' ".format(finidat) + + # call build-namelist + cmd = os.path.abspath(os.path.join(path_to_ctsm_root(), "bld", "build-namelist")) + command = [cmd, + '-cimeroot', cime_path, + '-infile', infile, + '-csmdata', inputdata_path, + '-inputdata', inputdatalist_path, + # Hard-code start_ymd of year-2000. This is used to set the run type (for + # which a setting of 2000 gives 'startup', which is what we want) and pick + # the initial conditions file (which is pretty much irrelevant when running + # with lilac). + '-namelist', '&clm_inparm start_ymd=20000101 {} /'.format(extra_namelist_opts), + '-use_case', use_case, + # For now, we assume ignore_ic_year, not ignore_ic_date + '-ignore_ic_year', + # -clm_start_type seems unimportant (see discussion in + # https://github.com/ESCOMP/CTSM/issues/876) + '-clm_start_type', 'default', + '-configuration', configuration, + '-structure', structure, + '-lnd_frac', lnd_domain_file, + '-glc_nec', str(10), + '-co2_ppmv', co2_ppmv, + '-co2_type', 'constant', + '-clm_accelerated_spinup', spinup, + '-lnd_tuning_mode', lnd_tuning_mode, + # Eventually make -no-megan dynamic (see + # https://github.com/ESCOMP/CTSM/issues/926) + '-no-megan', + '-config', os.path.join(rundir, "config_cache.xml"), + '-envxml_dir', rundir] + # NOTE(wjs, 2020-06-16) Note that we do NOT use the -mask argument; it's possible that + # we should be using it in some circumstances (I haven't looked into how it's used). + command.extend(['-res', 'lilac', + '-clm_usr_name', 'lilac']) + command.extend(bldnml_opts.split()) + + subprocess.check_call(command, + universal_newlines=True) + + # remove temporary files in rundir + os.remove(os.path.join(rundir, "config_cache.xml")) + os.remove(os.path.join(rundir, "env_lilac.xml")) + os.remove(os.path.join(rundir, "drv_flds_in")) + os.remove(infile) + +############################################################################### +def main(cime_path): + """Main function + + Args: + cime_path (str): path to the cime that we're using (this is passed in explicitly + rather than relying on calling path_to_cime so that we can be absolutely sure that + the scripts called here are coming from the same cime as the cime library we're + using). + """ + setup_logging_pre_config() + args = parse_command_line() + process_logging_args(args) + + buildnml( + cime_path=cime_path, + rundir=args.rundir) + +############################################################################### diff --git a/python/ctsm/machine_utils.py b/python/ctsm/machine_utils.py index 78f6ea85bf..41459ce3de 100644 --- a/python/ctsm/machine_utils.py +++ b/python/ctsm/machine_utils.py @@ -6,7 +6,6 @@ import getpass import socket import re -import os # ======================================================================== # Public functions @@ -22,18 +21,6 @@ def get_machine_name(): hostname = full_hostname.split('.')[0] return _machine_from_hostname(hostname) -def make_link(src, dst): - """Makes a link pointing to src named dst - - Does nothing if link is already set up correctly - """ - if os.path.islink(dst) and os.readlink(dst) == src: - # Link is already set up correctly: do nothing (os.symlink raises an exception if - # you try to replace an existing file) - pass - else: - os.symlink(src, dst) - # ======================================================================== # Private functions # ======================================================================== diff --git a/python/ctsm/os_utils.py b/python/ctsm/os_utils.py new file mode 100644 index 0000000000..aac5680057 --- /dev/null +++ b/python/ctsm/os_utils.py @@ -0,0 +1,50 @@ +"""Various OS-related utility functions +""" + +import os +import subprocess +from ctsm.utils import abort + +def run_cmd_output_on_error(cmd, errmsg, cwd=None): + """Run the given command; suppress output but print it if there is an error + + If there is an error running the command, print the output from the command and abort + with the given errmsg. + + Args: + cmd: list of strings - command and its arguments + errmsg: string - error message to print if the command returns an error code + cwd: string or None - path from which the command should be run + """ + try: + _ = subprocess.check_output(cmd, + stderr=subprocess.STDOUT, + universal_newlines=True, + cwd=cwd) + except subprocess.CalledProcessError as error: + print('ERROR while running:') + print(' '.join(cmd)) + if cwd is not None: + print('From {}'.format(cwd)) + print('') + print(error.output) + print('') + abort(errmsg) + except: + print('ERROR trying to run:') + print(' '.join(cmd)) + if cwd is not None: + print('From {}'.format(cwd)) + raise + +def make_link(src, dst): + """Makes a link pointing to src named dst + + Does nothing if link is already set up correctly + """ + if os.path.islink(dst) and os.readlink(dst) == src: + # Link is already set up correctly: do nothing (os.symlink raises an exception if + # you try to replace an existing file) + pass + else: + os.symlink(src, dst) diff --git a/python/ctsm/run_ctsm_py_tests.py b/python/ctsm/run_ctsm_py_tests.py index 469940581a..f0171a1940 100644 --- a/python/ctsm/run_ctsm_py_tests.py +++ b/python/ctsm/run_ctsm_py_tests.py @@ -21,6 +21,15 @@ def main(description): 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) @@ -28,7 +37,7 @@ def main(description): mydir = os.path.dirname(os.path.abspath(__file__)) testsuite = unittest.defaultTestLoader.discover( start_dir=mydir, - pattern=args.pattern) + 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. @@ -51,9 +60,17 @@ def _commandline_args(description): output_level.add_argument('-d', '--debug', action='store_true', help='Run tests with even more verbosity') - parser.add_argument('-p', '--pattern', default='test*.py', - help='File name pattern to match\n' - 'Default is test*.py') + 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() diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index e177dcd0e8..2e64425c7e 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -8,9 +8,10 @@ from datetime import datetime from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args -from ctsm.machine_utils import get_machine_name, make_link +from ctsm.machine_utils import get_machine_name from ctsm.machine import create_machine, get_possibly_overridden_baseline_dir from ctsm.machine_defaults import MACHINE_DEFAULTS +from ctsm.os_utils import make_link from ctsm.path_utils import path_to_ctsm_root from ctsm.joblauncher.job_launcher_factory import JOB_LAUNCHER_NOBATCH diff --git a/python/ctsm/test/joblauncher/test_job_launcher_no_batch.py b/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py similarity index 100% rename from python/ctsm/test/joblauncher/test_job_launcher_no_batch.py rename to python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py diff --git a/python/ctsm/test/test_sys_lilac_build_ctsm.py b/python/ctsm/test/test_sys_lilac_build_ctsm.py new file mode 100755 index 0000000000..74121ba90d --- /dev/null +++ b/python/ctsm/test/test_sys_lilac_build_ctsm.py @@ -0,0 +1,100 @@ +#!/usr/bin/env python + +"""System tests for lilac_build_ctsm + +These tests do a lot of work (interacting with cime, etc.), and thus take relatively long +to run. +""" + +import unittest +import tempfile +import shutil +import os + +from ctsm.path_utils import add_cime_lib_to_path +from ctsm import unit_testing +from ctsm.lilac_build_ctsm import build_ctsm + +_CIME_PATH = add_cime_lib_to_path(standalone_only=True) + +# Allow names that pylint doesn't like, because otherwise I find it hard +# to make readable unit test names +# pylint: disable=invalid-name + +class TestSysBuildCtsm(unittest.TestCase): + """System tests for lilac_build_ctsm""" + + def setUp(self): + self._tempdir = tempfile.mkdtemp() + + def tearDown(self): + shutil.rmtree(self._tempdir, ignore_errors=True) + + def test_buildSetup_userDefinedMachine_minimalInfo(self): + """Get through the case.setup phase with a user-defined machine + + This tests that the xml files are created successfully and that they are + compatible with cime's xml schemas. It also ensures that the creation of + various directories goes smoothly. + + This version specifies a minimal amount of information + """ + build_dir = os.path.join(self._tempdir, 'ctsm_build') + build_ctsm(cime_path=_CIME_PATH, + build_dir=build_dir, + compiler='gnu', + no_build=True, + os_type='linux', + netcdf_path='/path/to/netcdf', + esmf_lib_path='/path/to/esmf/lib', + max_mpitasks_per_node=16, + gmake='gmake', + gmake_j=8, + no_pnetcdf=True) + # the critical piece of this test is that the above command doesn't generate any + # errors; however we also do some assertions below + + # ensure that inputdata directory was created + inputdata = os.path.join(build_dir, 'inputdata') + self.assertTrue(os.path.isdir(inputdata)) + + def test_buildSetup_userDefinedMachine_allInfo(self): + """Get through the case.setup phase with a user-defined machine + + This tests that the xml files are created successfully and that they are + compatible with cime's xml schemas. It also ensures that the creation of + various directories goes smoothly. + + This version specifies all possible information + """ + build_dir = os.path.join(self._tempdir, 'ctsm_build') + inputdata_path = os.path.realpath(os.path.join(self._tempdir, 'my_inputdata')) + os.makedirs(inputdata_path) + build_ctsm(cime_path=_CIME_PATH, + build_dir=build_dir, + compiler='gnu', + no_build=True, + os_type='linux', + netcdf_path='/path/to/netcdf', + esmf_lib_path='/path/to/esmf/lib', + max_mpitasks_per_node=16, + gmake='gmake', + gmake_j=8, + pnetcdf_path='/path/to/pnetcdf', + pio_filesystem_hints='gpfs', + gptl_nano_timers=True, + extra_fflags='-foo', + extra_cflags='-bar', + build_debug=True, + build_with_openmp=True, + inputdata_path=os.path.join(self._tempdir, 'my_inputdata')) + # the critical piece of this test is that the above command doesn't generate any + # errors; however we also do some assertions below + + # ensure that inputdata directory is NOT created + inputdata = os.path.join(build_dir, 'inputdata') + self.assertFalse(os.path.exists(inputdata)) + +if __name__ == '__main__': + unit_testing.setup_for_tests() + unittest.main() diff --git a/python/ctsm/test/test_unit_lilac_build_ctsm.py b/python/ctsm/test/test_unit_lilac_build_ctsm.py new file mode 100755 index 0000000000..677de63da4 --- /dev/null +++ b/python/ctsm/test/test_unit_lilac_build_ctsm.py @@ -0,0 +1,236 @@ +#!/usr/bin/env python + +"""Unit tests for lilac_build_ctsm +""" + +import unittest +from unittest.mock import patch +from io import StringIO + +from ctsm import unit_testing +from ctsm.lilac_build_ctsm import _commandline_args, _check_and_transform_os + +# Allow names that pylint doesn't like, because otherwise I find it hard +# to make readable unit test names +# pylint: disable=invalid-name + +# pylint: disable=line-too-long + +class TestBuildCtsm(unittest.TestCase): + """Tests of lilac_build_ctsm""" + + # ------------------------------------------------------------------------ + # Tests of _commandline_args + # ------------------------------------------------------------------------ + + def test_commandlineArgs_rebuild_valid(self): + """Test _commandline_args with --rebuild, with a valid argument list (no disallowed args)""" + # pylint: disable=no-self-use + _ = _commandline_args(args_to_parse=['build/directory', '--rebuild']) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid1(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is required for non-rebuilds, without a dash + """ + expected_re = r"--compiler cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--compiler', 'intel']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid2(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is required for new machines, without a dash + """ + expected_re = r"--os cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--os', 'linux']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid3(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is required for new machines, with a dash + """ + expected_re = r"--netcdf-path cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--netcdf-path', '/path/to/netcdf']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid4(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is optional for new non-rebuild + that isn't None + """ + expected_re = r"--no-build cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--no-build']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid5(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is optional for new machines, which also has a default + that isn't None + """ + expected_re = r"--gmake cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--gmake', 'mymake']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + def test_commandlineArgs_noRebuild_valid(self): + """Test _commandline_args without --rebuild or --machine, with a valid argument list + + (all required things present) + """ + # pylint: disable=no-self-use + _ = _commandline_args(args_to_parse=['build/directory', + '--os', 'linux', + '--compiler', 'intel', + '--netcdf-path', '/path/to/netcdf', + '--esmf-lib-path', '/path/to/esmf/lib', + '--max-mpitasks-per-node', '16', + '--no-pnetcdf']) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_noRebuild_invalid1(self, mock_stderr): + """Test _commandline_args without --rebuild or --machine, with a missing required argument + + This tests an argument in the non-rebuild-required list + """ + expected_re = r"--compiler must be provided if --rebuild is not set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--os', 'linux', + '--netcdf-path', '/path/to/netcdf', + '--esmf-lib-path', '/path/to/esmf/lib', + '--max-mpitasks-per-node', '16', + '--no-pnetcdf']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_noRebuild_invalid2(self, mock_stderr): + """Test _commandline_args without --rebuild or --machine, with a missing required argument + + This tests an argument in the new-machine-required list + """ + expected_re = r"--os must be provided if neither --machine nor --rebuild are set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--compiler', 'intel', + '--netcdf-path', '/path/to/netcdf', + '--esmf-lib-path', '/path/to/esmf/lib', + '--max-mpitasks-per-node', '16', + '--no-pnetcdf']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_noRebuild_invalidNeedToDictatePnetcdf(self, mock_stderr): + """Test _commandline_args without --rebuild or --machine: invalid b/c nothing specified for pnetcdf""" + expected_re = r"For a user-defined machine, need to specify either --no-pnetcdf or --pnetcdf-path" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--os', 'linux', + '--compiler', 'intel', + '--netcdf-path', '/path/to/netcdf', + '--esmf-lib-path', '/path/to/esmf/lib', + '--max-mpitasks-per-node', '16']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_noRebuild_invalidConflictingPnetcdf(self, mock_stderr): + """Test _commandline_args without --rebuild or --machine: invalid b/c of conflicting specifications for pnetcdf""" + expected_re = r"--no-pnetcdf cannot be given if you set --pnetcdf-path" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--os', 'linux', + '--compiler', 'intel', + '--netcdf-path', '/path/to/netcdf', + '--esmf-lib-path', '/path/to/esmf/lib', + '--max-mpitasks-per-node', '16', + '--no-pnetcdf', + '--pnetcdf-path', '/path/to/pnetcdf']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + def test_commandlineArgs_machine_valid(self): + """Test _commandline_args with --machine, with a valid argument list + + (all required things present) + """ + # pylint: disable=no-self-use + _ = _commandline_args(args_to_parse=['build/directory', + '--machine', 'mymachine', + '--compiler', 'intel']) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_machine_missingRequired(self, mock_stderr): + """Test _commandline_args with --machine, with a missing required argument + """ + expected_re = r"--compiler must be provided if --rebuild is not set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--machine', 'mymachine']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_machine_illegalArg1(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is illegal with this option + + This tests an argument that is required for new machines + """ + expected_re = r"--os cannot be provided if --machine is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--machine', 'mymachine', + '--compiler', 'intel', + '--os', 'linux']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_machine_illegalArg2(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is illegal with this option + + This tests an argument that is optional for new machines + """ + expected_re = r"--gmake cannot be provided if --machine is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--machine', 'mymachine', + '--compiler', 'intel', + '--gmake', 'mymake']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + # ------------------------------------------------------------------------ + # Tests of _check_and_transform_os + # ------------------------------------------------------------------------ + + def test_checkAndTransformOs_valid(self): + """Test _check_and_transform_os with valid input""" + os = _check_and_transform_os('linux') + self.assertEqual(os, 'LINUX') + + def test_checkAndTransformOs_invalid(self): + """Test _check_and_transform_os with invalid input""" + with self.assertRaises(ValueError): + _ = _check_and_transform_os('bad_os') + +if __name__ == '__main__': + unit_testing.setup_for_tests() + unittest.main() diff --git a/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py new file mode 100755 index 0000000000..7c94089269 --- /dev/null +++ b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py @@ -0,0 +1,54 @@ +#!/usr/bin/env python + +"""Unit tests for lilac_make_runtime_inputs +""" + +import unittest + +from ctsm import unit_testing +from ctsm.lilac_make_runtime_inputs import determine_bldnml_opts + +# Allow names that pylint doesn't like, because otherwise I find it hard +# to make readable unit test names +# pylint: disable=invalid-name + +class TestMakeRuntimeInputs(unittest.TestCase): + """Tests of lilac_make_runtime_inputs""" + + def test_buildnmlOpts_bgc(self): + """Test determine_buildnml_opts with bgc_mode='bgc'""" + bldnml_opts = determine_bldnml_opts(bgc_mode='bgc', crop='off', vichydro='off') + self.assertRegex(bldnml_opts, r'^ *-bgc bgc *$') + + def test_buildnmlOpts_fates(self): + """Test determine_buildnml_opts with bgc_mode='fates'""" + bldnml_opts = determine_bldnml_opts(bgc_mode='fates', crop='off', vichydro='off') + self.assertRegex(bldnml_opts, r'^ *-bgc fates +-no-megan *$') + + def test_buildnmlOpts_bgcCrop(self): + """Test determine_buildnml_opts with bgc_mode='bgc' and crop on""" + bldnml_opts = determine_bldnml_opts(bgc_mode='bgc', crop='on', vichydro='off') + self.assertRegex(bldnml_opts, r'^ *-bgc bgc +-crop *$') + + def test_buildnmlOpts_spCrop_fails(self): + """Test determine_buildnml_opts with bgc_mode='sp' and crop on: should fail""" + with self.assertRaisesRegex( + SystemExit, + "setting crop to 'on' is only compatible with bgc_mode"): + _ = determine_bldnml_opts(bgc_mode='sp', crop='on', vichydro='off') + + def test_buildnmlOpts_spVic(self): + """Test determine_buildnml_opts with bgc_mode='sp' and vic on""" + bldnml_opts = determine_bldnml_opts(bgc_mode='sp', crop='off', vichydro='on') + self.assertRegex(bldnml_opts, r'^ *-bgc sp +-vichydro *$') + + def test_buildnmlOpts_bgcVic(self): + """Test determine_buildnml_opts with bgc_mode='bgc' and vic on: should fail""" + with self.assertRaisesRegex( + SystemExit, + "setting vichydro to 'on' is only compatible with bgc_mode of 'sp'"): + _ = determine_bldnml_opts(bgc_mode='bgc', crop='off', vichydro='on') + +if __name__ == '__main__': + unit_testing.setup_for_tests() + unittest.main() diff --git a/python/ctsm/test/test_machine.py b/python/ctsm/test/test_unit_machine.py old mode 100644 new mode 100755 similarity index 100% rename from python/ctsm/test/test_machine.py rename to python/ctsm/test/test_unit_machine.py diff --git a/python/ctsm/test/test_path_utils.py b/python/ctsm/test/test_unit_path_utils.py old mode 100644 new mode 100755 similarity index 100% rename from python/ctsm/test/test_path_utils.py rename to python/ctsm/test/test_unit_path_utils.py diff --git a/python/ctsm/test/test_run_sys_tests.py b/python/ctsm/test/test_unit_run_sys_tests.py old mode 100644 new mode 100755 similarity index 100% rename from python/ctsm/test/test_run_sys_tests.py rename to python/ctsm/test/test_unit_run_sys_tests.py diff --git a/python/ctsm/test/test_unit_utils.py b/python/ctsm/test/test_unit_utils.py new file mode 100755 index 0000000000..34449aa93c --- /dev/null +++ b/python/ctsm/test/test_unit_utils.py @@ -0,0 +1,57 @@ +#!/usr/bin/env python + +"""Unit tests for utils +""" + +import tempfile +import shutil +import unittest +import os + +from ctsm import unit_testing +from ctsm.utils import fill_template_file + +# Allow names that pylint doesn't like, because otherwise I find it hard +# to make readable unit test names +# pylint: disable=invalid-name + +class TestUtilsFillTemplateFile(unittest.TestCase): + """Tests of utils: fill_template_file""" + + def setUp(self): + self._testdir = tempfile.mkdtemp() + + def tearDown(self): + shutil.rmtree(self._testdir, ignore_errors=True) + + def test_fillTemplateFile_basic(self): + """Basic test of fill_template_file""" + template_path = os.path.join(self._testdir, 'template.txt') + final_path = os.path.join(self._testdir, 'final.txt') + template_contents = """\ +Hello +$foo +Goodbye +$bar +""" + with open(template_path, 'w') as f: + f.write(template_contents) + + fillins = {'foo':'aardvark', + 'bar':'zyzzyva'} + fill_template_file(template_path, final_path, fillins) + + expected_final_text = """\ +Hello +aardvark +Goodbye +zyzzyva +""" + with open(final_path) as f: + final_contents = f.read() + + self.assertEqual(final_contents, expected_final_text) + +if __name__ == '__main__': + unit_testing.setup_for_tests() + unittest.main() diff --git a/python/ctsm/utils.py b/python/ctsm/utils.py new file mode 100644 index 0000000000..09a08ff9af --- /dev/null +++ b/python/ctsm/utils.py @@ -0,0 +1,35 @@ +"""General-purpose utility functions""" + +import logging +import sys +import string + +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): + import pdb + pdb.set_trace() + + sys.exit('ERROR: {}'.format(errmsg)) + +def fill_template_file(path_to_template, path_to_final, substitutions): + """Given a template file (based on python's template strings), write a copy of the + file with template values filled in. + + Args: + path_to_template (str): path to the existing template file + path_to_final (str): path to where the final version will be written + substitutions (dict): key-value pairs for the template string substitutions + """ + + with open(path_to_template) as template_file: + template_file_contents = template_file.read() + template = string.Template(template_file_contents) + final_file_contents = template.substitute(substitutions) + with open(path_to_final, 'w') as final_file: + final_file.write(final_file_contents) diff --git a/run_sys_tests b/run_sys_tests index 6963e99d8a..bccf6f00e1 100755 --- a/run_sys_tests +++ b/run_sys_tests @@ -1,8 +1,6 @@ #!/usr/bin/env python """Driver for running CTSM system tests""" -from __future__ import print_function - import os import sys diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 0416a9e053..19af9c9343 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -55,6 +55,7 @@ module FrictionVelocityMod 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] + real(r8), pointer, public :: z0m_actual_patch (:) ! patch roughness length actually used in flux calculations, momentum [m] contains @@ -62,6 +63,7 @@ module FrictionVelocityMod procedure, public :: Init procedure, public :: Restart procedure, public :: SetRoughnessLengthsAndForcHeightsNonLake ! Set roughness lengths and forcing heights for non-lake points + procedure, public :: SetActualRoughnessLengths ! Set roughness lengths actually used in flux calculations procedure, public :: FrictionVelocity ! Calculate friction velocity procedure, public :: MoninObukIni ! Initialization of the Monin-Obukhov length @@ -136,6 +138,7 @@ subroutine InitAllocate(this, bounds) 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 + allocate(this%z0m_actual_patch (begp:endp)) ; this%z0m_actual_patch (:) = nan end subroutine InitAllocate @@ -493,6 +496,72 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & end subroutine SetRoughnessLengthsAndForcHeightsNonLake + !----------------------------------------------------------------------- + subroutine SetActualRoughnessLengths(this, bounds, & + num_exposedvegp, filter_exposedvegp, & + num_noexposedvegp, filter_noexposedvegp, & + num_urbanp, filter_urbanp, & + num_lakep, filter_lakep) + ! + ! !DESCRIPTION: + ! Set roughness lengths actually used in flux calculations + ! + ! !ARGUMENTS: + class(frictionvel_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 + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 (but does NOT include lake or urban) + integer , intent(in) :: num_urbanp ! number of points in filter_urbanp + integer , intent(in) :: filter_urbanp(:) ! patch filter for urban + integer , intent(in) :: num_lakep ! number of points in filter_lakep + integer , intent(in) :: filter_lakep(:) ! patch filter for lake + ! + ! !LOCAL VARIABLES: + integer :: fp, p, c, l + + character(len=*), parameter :: subname = 'SetActualRoughnessLengths' + !----------------------------------------------------------------------- + + associate( & + z_0_town => lun%z_0_town , & ! Input: [real(r8) (:)] momentum roughness length of urban landunit [m] + + z0mv => this%z0mv_patch , & ! Input: [real(r8) (:)] roughness length over vegetation, momentum [m] + z0mg => this%z0mg_col , & ! Input: [real(r8) (:)] roughness length over ground, momentum [m] + z0m_actual => this%z0m_actual_patch & ! Output: [real(r8) (:)] roughness length actually used in flux calculations, momentum [m] + ) + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + + z0m_actual(p) = z0mv(p) + end do + + do fp = 1, num_noexposedvegp + p = filter_noexposedvegp(fp) + c = patch%column(p) + + z0m_actual(p) = z0mg(c) + end do + + do fp = 1, num_urbanp + p = filter_urbanp(fp) + l = patch%landunit(p) + + z0m_actual(p) = z_0_town(l) + end do + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + + z0m_actual(p) = z0mg(c) + end do + + end associate + end subroutine SetActualRoughnessLengths + !------------------------------------------------------------------------------ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & displa, z0m, z0h, z0q, & diff --git a/src/biogeophys/Waterlnd2atmType.F90 b/src/biogeophys/Waterlnd2atmType.F90 index fdef91695c..ed6e9ca0dd 100644 --- a/src/biogeophys/Waterlnd2atmType.F90 +++ b/src/biogeophys/Waterlnd2atmType.F90 @@ -25,7 +25,7 @@ module Waterlnd2atmType class(water_info_base_type), pointer :: info real(r8), pointer :: q_ref2m_grc (:) ! 2m surface specific humidity (kg/kg) - real(r8), pointer :: h2osno_grc (:) ! snow water (mm H2O) + real(r8), pointer :: h2osno_grc (:) ! snow water (m H2O) real(r8), pointer :: qflx_evap_tot_grc (:) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg real(r8), pointer :: qflx_rofliq_grc (:) ! rof liq forcing real(r8), pointer :: qflx_rofliq_qsur_grc (:) ! rof liq -- surface runoff component diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 new file mode 100644 index 0000000000..ba5f73c2b7 --- /dev/null +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -0,0 +1,954 @@ +module lnd_comp_esmf + + !---------------------------------------------------------------------------- + ! This is the ESMF cap for CTSM + ! NOTE : both mpi_init and pio_init1 are initialized in lilac_mod.F90 + !---------------------------------------------------------------------------- + + ! external libraries + use ESMF + use shr_mpi_mod , only : shr_mpi_bcast + use perf_mod , only : t_startf, t_stopf, t_barrierf + + ! lilac code + use ctsm_LilacCouplingFields, only : a2l_fields, l2a_fields + + ! cime share code + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit + use shr_orb_mod , only : shr_orb_decl, shr_orb_params + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_nl_mod , only : shr_nl_find_group_name + use glc_elevclass_mod , only : glc_elevclass_init + + ! ctsm code + use spmdMod , only : masterproc, spmd_init, mpicom + use decompMod , only : bounds_type, ldecomp, get_proc_bounds + use domainMod , only : ldomain + use controlMod , only : control_setNL + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use clm_varctl , only : clm_varctl_set, iulog, finidat + use clm_varctl , only : nsrStartup, nsrContinue + use clm_varctl , only : inst_index, inst_suffix, inst_name + use clm_time_manager , only : set_timemgr_init, advance_timestep + use clm_time_manager , only : set_nextsw_cday, update_rad_dtime + use clm_time_manager , only : get_nstep, get_step_size + use clm_time_manager , only : get_curr_date, get_curr_calday + use clm_initializeMod , only : initialize1, initialize2 + use clm_driver , only : clm_drv + use lnd_import_export , only : import_fields, export_fields + use lnd_shr_methods , only : chkerr, state_diagnose + + implicit none + private ! By default make data private except + + public :: lnd_register ! register clm initial, run, final methods + public :: lnd_init ! clm initialization + public :: lnd_run ! clm run phase + public :: lnd_final ! clm finalization/cleanup + + !-------------------------------------------------------------------------- + ! Private module data + !-------------------------------------------------------------------------- + + integer :: glc_nec = 10 ! fixed # of glc elevation classes + integer, parameter :: memdebug_level=1 + integer, parameter :: dbug = 1 + character(*), parameter :: modName = "lnd_comp_esmf" + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lnd_register(comp, rc) + + ! Register the clm initial, run, and final phase methods with ESMF. + + ! input/output argumenents + type(ESMF_GridComp) :: comp ! CLM grid component + integer, intent(out) :: rc ! return status + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogSet ( flush =.true.) + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, lnd_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, lnd_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, lnd_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_LogWrite("lnd gridcompset entry points finished!", ESMF_LOGMSG_INFO) + + end subroutine lnd_register + + !=============================================================================== + + subroutine lnd_init(comp, import_state, export_state, clock, rc) + + ! Initialize land surface model and obtain relevant atmospheric model arrays + ! back from (i.e. albedos, surface temperature and snow cover over land). + + ! input/output variables + type(ESMF_GridComp) :: comp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + + ! local variables + integer :: ierr ! error code + integer :: n,g,i,j ! indices + logical :: exists ! true if file exists + character(len=CL) :: caseid ! case identifier name + character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) + real(r8) :: nextsw_cday ! calday next radiation computation + integer :: nsrest ! clm restart type + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit ! old values for log unit and log level + type(bounds_type) :: bounds ! bounds + character(len=CL) :: cvalue + + ! communicator info + type(ESMF_VM) :: vm + integer :: mpicom_vm + + ! generation of field bundles + type(ESMF_State) :: importState, exportState + type(ESMF_FieldBundle) :: c2l_fb_atm, c2l_fb_rof ! field bundles in import state + type(ESMF_FieldBundle) :: l2c_fb_atm, l2c_fb_rof ! field bundles in export state + type(ESMF_Field) :: lfield + + ! mesh generation + type(ESMF_Mesh) :: lnd_mesh + character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file + integer :: nlnd, nocn ! local size ofarrays + integer, pointer :: gindex(:) ! global index space for land and ocean points + integer, pointer :: gindex_lnd(:) ! global index space for just land points + integer, pointer :: gindex_ocn(:) ! global index space for just ocean points + type(ESMF_DistGrid) :: distgrid + integer :: fileunit + + ! clock info + character(len=CL) :: calendar ! calendar type name + type(ESMF_CalKind_Flag) :: caltype ! calendar type from lilac clock + integer :: curr_tod, curr_ymd ! current time info + integer :: yy, mm, dd ! query output from lilac clock + integer :: dtime_lilac ! coupling time-step from the input lilac clock + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep ! time step from lilac clock + + ! orbital info + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_iyear ! orbital year for current orbital computation + integer :: orb_eccen ! orbital year for current orbital computation + + character(len=*), parameter :: subname=trim(modName)//': (lnd_init) ' + !------------------------------------------------------------------------ + + ! input namelist read for ctsm mesh + namelist /lilac_lnd_input/ lnd_mesh_filename + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' is called!', ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------ + ! Query VM for local PET and mpi communicator + !------------------------------------------------------------------------ + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_LogWrite(subname//"ESMF_VMGet", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------ + ! Initialize internal ctsm MPI info + !------------------------------------------------------------------------ + + call spmd_init( clm_mpicom=mpicom_vm, lndid=1) + call ESMF_LogWrite(subname//"initialized model mpi info using spmd_init", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------ + ! Initialize output log file + !------------------------------------------------------------------------ + + ! TODO: by default iulog = 6 in clm_varctl - this should be generalized so that we + ! can control the output log file for ctsm running with a lilac driver + ! + ! See also https://github.com/ESCOMP/CTSM/issues/861 + + inst_name = 'LND'; inst_index = 1; inst_suffix = "" + + ! Initialize io log unit + call shr_file_getLogUnit (shrlogunit) + if (.not. masterproc) then + iulog = shrlogunit ! All shr code output will go to iulog for masterproc + end if + call shr_file_setLogUnit (iulog) + + if (masterproc) then + write(iulog,*) "=========================================" + write(iulog,*) " starting (lnd_comp_esmf): lnd_comp_init " + write(iulog,*) " CLM land model initialization" + end if + + !------------------------------------------------------------------------ + !--- Orbital Values --- + !------------------------------------------------------------------------ + + ! TODO: orbital values should be provided by lilac - but for now lets use defaults + !! hard wire these these in and we can decide on maybe having a namelist/ + ! + ! See also https://github.com/ESCOMP/CTSM/issues/865 + + !call shr_cal_date2ymd(ymd,year,month,day) + !orb_cyear = orb_iyear + (year - orb_iyear_align) + + orb_cyear = 2000 + call shr_orb_params(orb_cyear, eccen, obliqr, mvelpp, obliqr, lambm0, mvelpp, masterproc) + + if (masterproc) then + write(iulog,*) 'shr_obs_params is setting the following:' + write(iulog,*) 'eccen is : ', eccen + write(iulog,*) 'mvelpp is : ', mvelpp + write(iulog,*) 'lambm0 is : ', lambm0 + write(iulog,*) 'obliqr is : ', obliqr + end if + + !---------------------- + ! Consistency check on namelist filename + !---------------------- + call control_setNL("lnd_in") + + !---------------------- + ! Read in lilac_in namelists + !---------------------- + + if (masterproc) then + open(newunit=fileunit, status="old", file="lilac_in") + call shr_nl_find_group_name(fileunit, 'lilac_lnd_input', ierr) + if (ierr == 0) then + read(fileunit, lilac_lnd_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of lilac_lnd_input') + end if + end if + close(fileunit) + end if + call shr_mpi_bcast(lnd_mesh_filename, mpicom) + + !---------------------- + ! Obtain caseid and start type from attributes in import state + !---------------------- + + call ESMF_AttributeGet(import_state, name="caseid", value=caseid, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"caseid is "//trim(caseid), ESMF_LOGMSG_INFO) + + call ESMF_AttributeGet(import_state, name="starttype", value=starttype, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"starttype is "//trim(starttype), ESMF_LOGMSG_INFO) + + if (trim(starttype) == trim('startup')) then + nsrest = nsrStartup + else if (trim(starttype) == trim('continue') ) then + nsrest = nsrContinue + else + call shr_sys_abort( subname//' ERROR: unknown starttype'//trim(starttype) ) + end if + + !---------------------- + ! Initialize module variables in clm_time_manger.F90 + !---------------------- + + call ESMF_ClockGet( clock, & + currTime=currTime, startTime=startTime, refTime=RefTime, timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,start_ymd) + + call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,ref_ymd) + + call ESMF_TimeGet( currTime, calkindflag=caltype, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (caltype == ESMF_CALKIND_NOLEAP) then + calendar = shr_cal_noleap + else if (caltype == ESMF_CALKIND_GREGORIAN) then + calendar = shr_cal_gregorian + else + call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) + end if + + call ESMF_TimeIntervalGet(timeStep, s=dtime_lilac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (masterproc) then + write(iulog,*)'dtime = ',dtime_lilac + end if + + ! The following sets the module variables in clm_time_mamanger.F90 - BUT DOES NOT intialize the + ! clock. Routine timemgr_init (called by initialize1) initializes the clock using the module variables + ! that have been set via calls to set_timemgr_init. + + ! Note that we assume that CTSM's internal dtime matches the coupling time step. + ! i.e., we currently do NOT allow sub-cycling within a coupling time step. + call set_timemgr_init( & + calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, dtime_in=dtime_lilac) + + !---------------------- + ! Read namelist, grid and surface data + !---------------------- + + ! set default values for run control variables + call clm_varctl_set(caseid_in=caseid, nsrest_in=nsrest) + call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) + + !---------------------- + ! Initialize glc_elevclass module + !---------------------- + + call glc_elevclass_init(glc_nec) + + !---------------------- + ! Call initialize1 + !---------------------- + + ! Note that the memory for gindex_ocn will be allocated in the following call + + call initialize1(dtime=dtime_lilac, gindex_ocn=gindex_ocn) + + call ESMF_LogWrite(subname//"ctsm time manager initialized....", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"ctsm initialize1 done...", ESMF_LOGMSG_INFO) + + !-------------------------------- + ! generate the land mesh on ctsm distribution + !-------------------------------- + + ! obtain global index array for just land points which includes mask=0 or ocean points + call get_proc_bounds( bounds ) + + nlnd = bounds%endg - bounds%begg + 1 + allocate(gindex_lnd(nlnd)) + do g = bounds%begg,bounds%endg + n = 1 + (g - bounds%begg) + gindex_lnd(n) = ldecomp%gdc2glo(g) + end do + + call ESMF_LogWrite(subname//"obtained global index", ESMF_LOGMSG_INFO) + + ! create a global index that includes both land and ocean points + nocn = size(gindex_ocn) + allocate(gindex(nlnd + nocn)) + do n = 1,nlnd+nocn + if (n <= nlnd) then + gindex(n) = gindex_lnd(n) + else + gindex(n) = gindex_ocn(n-nlnd) + end if + end do + + ! create distGrid from global index array + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + deallocate(gindex) + call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) + + ! create esmf mesh using distgrid and lnd_mesh_filename + lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistgrid=Distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) then + call shr_sys_abort("Error in creating mesh "// trim(lnd_mesh_filename)) + end if + if (masterproc) then + write(iulog,*)'mesh file for domain is ',trim(lnd_mesh_filename) + end if + call ESMF_LogWrite(subname//" Create Mesh using file ...."//trim(lnd_mesh_filename), ESMF_LOGMSG_INFO) + + !-------------------------------- + ! Finish initializing ctsm + !-------------------------------- + + call initialize2() + call ESMF_LogWrite(subname//"ctsm initialize2 done...", ESMF_LOGMSG_INFO) + + !-------------------------------- + ! Create import state (only assume input from atm - not rof and glc) + !-------------------------------- + + ! create an empty field bundle for import of atm fields + c2l_fb_atm = ESMF_FieldBundleCreate (name='c2l_fb_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! now add atm import fields on lnd_mesh to this field bundle + do n = 1, a2l_fields%num_fields() + lfield = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT, & + name=a2l_fields%get_fieldname(n), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(c2l_fb_atm, (/lfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! add the field bundle to the state + call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb_atm/)) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create an empty field bundle for the import of rof fields + c2l_fb_rof = ESMF_FieldBundleCreate (name='c2l_fb_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbundle_add('Flrr_flood', c2l_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrr_volr', c2l_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrr_volrmch', c2l_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add the field bundle to the state + call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb_rof/)) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !-------------------------------- + ! Create ctsm export state + !-------------------------------- + + ! create an empty field bundle for atm export fields + l2c_fb_atm = ESMF_FieldBundleCreate(name='l2c_fb_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! now add atm export fields on lnd_mesh to this field bundle + do n = 1, l2a_fields%num_fields() + lfield = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT, & + name=l2a_fields%get_fieldname(n), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(l2c_fb_atm, (/lfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! add the field bundle to the state + call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb_atm/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create an empty field bundle for rof export fields + l2c_fb_rof = ESMF_FieldBundleCreate(name='l2c_fb_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! now add rof export fields on lnd_mesh to this field bundle + call fldbundle_add('Flrl_rofsur', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofgwl', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofsub', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofi', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_irrig', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb_rof/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !-------------------------------- + ! Fill in ctsm export state + !-------------------------------- + + call export_fields(export_state, bounds, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + write(cvalue,*) ldomain%ni + call ESMF_AttributeSet(export_state, name="lnd_nx", value=trim(cvalue), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"set attribute lnd_nx to "//trim(cvalue), ESMF_LOGMSG_INFO) + + write(cvalue,*) ldomain%nj + call ESMF_AttributeSet(export_state, name="lnd_ny", value=trim(cvalue), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"set attribute lnd_ny to "//trim(cvalue), ESMF_LOGMSG_INFO) + + call ESMF_LogWrite(subname//"Created land export state", ESMF_LOGMSG_INFO) + + !-------------------------------- + ! Get calendar day of next sw (shortwave) calculation (nextsw_cday) + !-------------------------------- + + if (nsrest == nsrStartup) then + call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! TODO: get this from the import state nextsw_cday attribute + ! + ! See also https://github.com/ESCOMP/CTSM/issues/860 + end if + + ! Set nextsw_cday + call set_nextsw_cday(nextsw_cday_in=nextsw_cday) + + write(cvalue,*) nextsw_cday + call ESMF_LogWrite(subname//"Calendar Day of nextsw calculation is "//trim(cvalue), ESMF_LOGMSG_INFO) + if (masterproc) then + write(iulog,*) 'TimeGet ... nextsw_cday is : ', nextsw_cday + end if + + !-------------------------------- + ! diagnostics + !-------------------------------- + + if (dbug > 1) then + call State_diagnose(export_state, subname//':ExportState',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + +#if (defined _MEMTRACE) + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + call ESMF_LogWrite(subname//' CTSM INITIALIZATION DONE SUCCESSFULLY!!!! ', ESMF_LOGMSG_INFO) + + if (masterproc) then + write(iulog,*) " finished (lnd_comp_esmf): lnd_comp_init " + write(iulog,*) "=========================================" + end if + + !--------------------------- + contains + !--------------------------- + + subroutine fldbundle_add(stdname, fieldbundle, rc) + !--------------------------- + ! Create an empty input field with name 'stdname' to add to fieldbundle + !--------------------------- + + ! input/output variables + character(len=*) , intent(in) :: stdname + type (ESMF_FieldBundle) , intent(inout) :: fieldbundle + integer , intent(out) :: rc + ! local variables + type(ESMF_Field) :: field + !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(stdname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine fldbundle_add + + end subroutine lnd_init + + !--------------------------------------------------------------------------- + + subroutine lnd_run(gcomp, import_state, export_state, clock, rc) + + !------------------------ + ! Run CTSM + !------------------------ + + ! input/output variables + type(ESMF_GridComp) :: gcomp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + + ! local variables: + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime + character(ESMF_MAXSTR) :: cvalue + integer :: ymd ! CTSM current date (YYYYMMDD) + integer :: yr ! CTSM current year + integer :: mon ! CTSM current month + integer :: day ! CTSM current day + integer :: tod ! CTSM current time of day (sec) + integer :: ymd_lilac ! Sync date (YYYYMMDD) + integer :: yr_lilac ! Sync current year + integer :: mon_lilac ! Sync current month + integer :: day_lilac ! Sync current day + integer :: tod_lilac ! Sync current time of day (sec) + integer :: dtime ! time step increment (sec) + integer :: nstep ! time step index + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend ! .true. ==> last time-step + logical :: dosend ! true => send data back to driver + logical :: doalb ! .true. ==> do albedo calculation on this time step + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + real(r8) :: caldayp1 ! ctsm calday plus dtime offset + integer :: lbnum ! input to memory diagnostic + integer :: g,i ! 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 + type(bounds_type) :: bounds ! bounds + character(len=32) :: rdate ! date char string for restart file names + logical :: first_call = .true. ! true if and only if this is the first time this routine is called in this execution + character(*) , parameter :: F02 = "('[lnd_comp_esmf] ',a, d26.19)" + character(len=*), parameter :: subname=trim(modName)//':[lnd_run] ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_comp_nuopc_ModelAdvance:start::',lbnum) + endif +#endif + + !---------------------- + ! Obtain orbital values + !---------------------- + + !call ESMF_AttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) eccen + + !call ESMF_AttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) obliqr + + !call ESMF_AttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) lambm0 + + !call ESMF_AttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) mvelpp + + !-------------------------------- + ! Get processor bounds + !-------------------------------- + + call get_proc_bounds(bounds) + + !-------------------------------- + ! Unpack import state + !-------------------------------- + + call t_startf ('lc_lnd_import') + call import_fields(import_state, bounds, first_call, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf ('lc_lnd_import') + + !-------------------------------- + ! Run model + !-------------------------------- + + dtime = get_step_size() + dosend = .false. + do while(.not. dosend) + + ! We assume that the land model time step matches the coupling interval. However, + ! we still need this while loop to handle the initial time step (time 0). We may + ! want to get rid of this time step 0 in the lilac coupling, at which point we + ! should be able to remove this while loop and dosend variable. + ! + ! See also https://github.com/ESCOMP/CTSM/issues/925 + nstep = get_nstep() + if (nstep > 0) then + dosend = .true. + end if + + !-------------------------------- + ! Determine calendar day info + !-------------------------------- + + calday = get_curr_calday() + caldayp1 = get_curr_calday(offset=dtime) + + !-------------------------------- + ! Get time of next atmospheric shortwave calculation + !-------------------------------- + + ! TODO(NS): nextsw_cday should come directly from atmosphere! + ! For now I am setting nextsw_cday to be the same caldayp1 + ! + ! See also https://github.com/ESCOMP/CTSM/issues/860 + + nextsw_cday = calday + if (masterproc) then + write(iulog,*) trim(subname) // '... nextsw_cday is : ', nextsw_cday + end if + + !-------------------------------- + ! Obtain orbital values + !-------------------------------- + + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + + if (masterproc) then + write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + write(iulog,F02) 'nextsw_cday is : ', nextsw_cday + write(iulog,F02) 'calday is : ', calday + write(iulog,F02) 'eccen is : ', eccen + write(iulog,F02) 'mvelpp is : ', mvelpp + write(iulog,F02) 'lambm0 is : ', lambm0 + write(iulog,F02) 'obliqr is : ', obliqr + write(iulog,F02) 'declin is : ', declin + write(iulog,F02) 'declinp1 is : ', declinp1 + write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + end if + + !-------------------------------- + ! Determine doalb based on nextsw_cday sent from atm model + !-------------------------------- + + if (nstep == 0) then + doalb = .false. + nextsw_cday = caldayp1 + else if (nstep == 1) then + !doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + doalb = .false. + else + doalb = (nextsw_cday >= -0.5_r8) + end if + + if (masterproc) then + write(iulog,*) '------------ LILAC ----------------' + write(iulog,*) 'nstep : ', nstep + write(iulog,*) 'calday : ', calday + write(iulog,*) 'caldayp1 : ', caldayp1 + write(iulog,*) 'nextsw_cday : ', nextsw_cday + write(iulog,*) 'doalb : ', doalb + write(iulog,*) '-------------------------------------' + end if + + call update_rad_dtime(doalb) + + !-------------------------------- + ! Determine if time to write restart + !-------------------------------- + + call ESMF_ClockGetAlarm(clock, alarmname='lilac_restart_alarm', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + rstwr = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + rstwr = .false. + endif + if (masterproc) then + write(iulog,*)' restart alarm is ',rstwr + end if + + !-------------------------------- + ! Determine if time to stop + !-------------------------------- + + call ESMF_ClockGetAlarm(clock, alarmname='lilac_stop_alarm', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + nlend = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + nlend = .false. + endif + if (masterproc) then + write(iulog,*)' stop alarm is ',nlend + end if + + !-------------------------------- + ! Run CTSM + !-------------------------------- + + call t_barrierf('sync_ctsm_run1', mpicom) + + ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for restart file names + ! TODO: is this correct for lilac? + + call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr_lilac, mm=mon_lilac, dd=day_lilac, s=tod_lilac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_lilac, mon_lilac, day_lilac, tod_lilac + + call t_startf ('ctsm_run') + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic=.false.) + call t_stopf ('ctsm_run') + + !-------------------------------- + ! Pack export state + !-------------------------------- + + call t_startf ('lc_lnd_export') + call export_fields(export_state, bounds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf ('lc_lnd_export') + + !-------------------------------- + ! Advance ctsm time step + !-------------------------------- + + call advance_timestep() + + end do + + !-------------------------------- + ! Check that internal clock is in sync with lilac driver clock + !-------------------------------- + + ! Get ctsm current time info + call get_curr_date( yr, mon, day, tod, offset=-2*dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + + ! Get lilac clock info + call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yr_lilac, mm=mon_lilac, dd=day_lilac, s=tod_lilac, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yr_lilac, mon_lilac, day_lilac, ymd_lilac) + + if (masterproc) then + write(iulog,*)'lilac ymd=',ymd ,' lilac tod= ',tod + end if + + ! Note that the driver clock has not been updated yet - so at this point + ! CTSM is actually 1 coupling intervals ahead of the driver clock + + if ( (ymd /= ymd_lilac) .or. (tod /= tod_lilac) ) then + write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod + write(iulog,*)'lilac ymd=',ymd_lilac,' lilac tod= ',tod_lilac + call ESMF_LogWrite(subname//" CTSM clock not in sync with lilac clock",ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + + !-------------------------------- + ! diagnostics + !-------------------------------- + + !if (dbug > 1) then + ! call State_diagnose(exportState,subname//':ES',rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (masterproc) then + ! call log_clock_advance(clock, 'CTSM', iulog, rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end if + !end if + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_comp_nuopc_ModelAdvance:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + first_call = .false. + + end subroutine lnd_run + + !--------------------------------------------------------------------------- + + subroutine lnd_final(comp, import_state, export_state, clock, rc) + !--------------------------------- + ! Finalize land surface model + !--------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: comp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! TODO: Destroy ESMF objects + + end subroutine lnd_final + + !=============================================================================== + + subroutine log_clock_advance(clock, logunit, rc) + + ! input/output variables + type(ESMF_Clock) :: clock + integer , intent(in) :: logunit + integer , intent(out) :: rc + + ! local variables + character(len=CL) :: cvalue, prestring + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + write(prestring, *) "------>Advancing CTSM from: " + call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & + preString="--------------------------------> to: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + end subroutine log_clock_advance + +!=============================================================================== + + subroutine memcheck(string, level, mastertask) + + ! input/output variables + character(len=*) , intent(in) :: string + integer , intent(in) :: level + logical , intent(in) :: mastertask + + ! local variables + integer :: ierr + integer, external :: GPTLprint_memusage + !----------------------------------------------------------------------- + + if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + ierr = GPTLprint_memusage(string) + endif + + end subroutine memcheck + +end module lnd_comp_esmf diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 new file mode 100644 index 0000000000..313d0ce635 --- /dev/null +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -0,0 +1,849 @@ +module lnd_import_export + + use ESMF + use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs + use shr_infnan_mod , only : isnan => shr_infnan_isnan + use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum + use shr_sys_mod , only : shr_sys_abort + use shr_const_mod , only : SHR_CONST_TKFRZ, fillvalue=>SHR_CONST_SPVAL + use clm_varctl , only : iulog, co2_ppmv, ndep_from_cpl + use clm_varcon , only : rair, o2_molar_const + use clm_time_manager , only : get_nstep + use clm_instMod , only : atm2lnd_inst, lnd2atm_inst, water_inst + use domainMod , only : ldomain + use spmdMod , only : masterproc + use decompmod , only : bounds_type + use lnd2atmType , only : lnd2atm_type + use lnd2glcMod , only : lnd2glc_type + use atm2lndType , only : atm2lnd_type + use lnd_shr_methods , only : chkerr + use shr_megan_mod , only : shr_megan_mechcomps_n ! TODO: need to add a namelist read here (see https://github.com/ESCOMP/CTSM/issues/926) + + implicit none + private ! except + + public :: import_fields + public :: export_fields + + private :: state_getimport + private :: state_setexport + private :: state_getfldptr + private :: check_for_nans + + ! from atm->lnd + integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn + + ! from lnd->atm + integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm + integer :: emis_nflds ! number of fire emission fields from lnd-> atm + + integer :: glc_nec = 10 ! number of glc elevation classes + integer, parameter :: debug = 0 ! internal debug level + + character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" + character(*),parameter :: F02 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d26.19)" + character(*),parameter :: u_FILE_u = & + __FILE__ + character(*),parameter :: modname = "[lnd_import_export]: " + +!=============================================================================== +contains +!=============================================================================== + + subroutine import_fields( importState, bounds, first_call, rc) + + !--------------------------------------------------------------------------- + ! Convert the input data from lilac to the land model + !--------------------------------------------------------------------------- + + ! input/output variables + type(ESMF_State) :: importState + type(bounds_type) , intent(in) :: bounds ! bounds + logical , intent(in) :: first_call ! true if and only if this is the first time we're calling import_fields from the run method + integer , intent(out) :: rc + + ! local variables + integer :: num + integer :: begg, endg ! bounds + integer :: g,i,k ! indices + real(r8) :: e ! vapor pressure (Pa) + real(r8) :: qsat ! saturation specific humidity (kg/kg) + real(r8) :: co2_ppmv_val ! temporary + 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 + real(r8) :: b0,b1,b2,b3,b4,b5,b6 ! coefficients for esat over ice + real(r8) :: tdc, t ! Kelvins to Celcius function and its input + real(r8) :: forc_t ! atmospheric temperature (Kelvin) + real(r8) :: forc_q ! atmospheric specific humidity (kg/kg) + real(r8) :: forc_pbot ! atmospheric pressure (Pa) + real(r8) :: forc_rainc(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s + real(r8) :: forc_rainl(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s + real(r8) :: forc_snowc(bounds%begg:bounds%endg) ! snowfxy Atm flux mm/s + real(r8) :: forc_snowl(bounds%begg:bounds%endg) ! snowfxl Atm flux mm/s + real(r8) :: forc_noy(bounds%begg:bounds%endg) + real(r8) :: forc_nhx(bounds%begg:bounds%endg) + real(r8) :: topo_grc(bounds%begg:bounds%endg, 0:glc_nec) + character(len=*), parameter :: subname='(lnd_import_export:import_fields)' + + ! Constants to compute vapor pressure + parameter (a0=6.107799961_r8 , a1=4.436518521e-01_r8, & + a2=1.428945805e-02_r8, a3=2.650648471e-04_r8, & + a4=3.031240396e-06_r8, a5=2.034080948e-08_r8, & + a6=6.136820929e-11_r8) + + parameter (b0=6.109177956_r8 , b1=5.034698970e-01_r8, & + b2=1.886013408e-02_r8, b3=4.176223716e-04_r8, & + b4=5.824720280e-06_r8, b5=4.838803174e-08_r8, & + b6=1.838826904e-10_r8) + + ! function declarations + tdc(t) = min( 50._r8, max(-50._r8,(t-SHR_CONST_TKFRZ)) ) + esatw(t) = 100._r8*(a0+t*(a1+t*(a2+t*(a3+t*(a4+t*(a5+t*a6)))))) + esati(t) = 100._r8*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6)))))) + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! Set bounds + begg = bounds%begg; endg=bounds%endg + + if (first_call) then + ! We only do this for the first call because we assume that the atmosphere's land + ! mask is constant in time. To allow for a varying land mask in the atmosphere + ! (doing checking each time), remove this first_call conditional. (It would be + ! more straightforward to pass this and check it in initialization, but that would + ! require atm-land communication in initialization, which currently isn't done + ! with the LILAC coupler.) + call check_atm_landfrac(importState, bounds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Note: 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 + ! by 1000 mm/m resulting in an overall factor of unity. + ! Below the units are therefore given in mm/s. + + !-------------------------- + ! Required atmosphere input fields + !-------------------------- + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_z', bounds, & + output=atm2lnd_inst%forc_hgt_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_topo', bounds, & + output=atm2lnd_inst%forc_topo_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_u', bounds, & + output=atm2lnd_inst%forc_u_grc, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_v', bounds, & + output=atm2lnd_inst%forc_v_grc, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_ptem', bounds, & + output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_shum', bounds, & + output=water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_pbot', bounds, & + output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_tbot', bounds, & + output=atm2lnd_inst%forc_t_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_rainc', bounds, & + output=forc_rainc, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_rainl', bounds, & + output=forc_rainl, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_snowc', bounds, & + output=forc_snowc, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_snowl', bounds, & + output=forc_snowl, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_lwdn', bounds, & + output=atm2lnd_inst%forc_lwrad_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swvdr', bounds, & + output=atm2lnd_inst%forc_solad_grc(:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swndr', bounds, & + output=atm2lnd_inst%forc_solad_grc(:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swvdf', bounds, & + output=atm2lnd_inst%forc_solai_grc(:,1), rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swndf', bounds, & + output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ! Atmosphere prognostic/prescribed aerosol fields + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphidry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphodry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphiwet', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,3), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphidry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,4), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphodry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,5), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphiwet', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,6), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet1', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,7), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry1', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,8), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet2', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,9), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry2', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,10), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet3', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,11), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry3', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,12), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet4', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,13), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry4', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,14), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call state_getimport(importState, 'c2l_fb_atm', 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! The lilac is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec + ! so the following conversion needs to happen + ! call state_getimport(importState, 'c2l_fb_atm', 'Faxa_nhx', bounds, output=forc_nhx, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'c2l_fb_atm', 'Faxa_noy', bounds, output=forc_noy, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do g = begg,endg + ! atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 + ! end do + + !-------------------------- + ! Set force flood back from river to 0 + !-------------------------- + + water_inst%wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 + + !-------------------------- + ! Derived quantities + !-------------------------- + + do g = begg, endg + forc_t = atm2lnd_inst%forc_t_not_downscaled_grc(g) + forc_q = water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) + forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) + + atm2lnd_inst%forc_hgt_u_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of wind [m] + atm2lnd_inst%forc_hgt_t_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of temperature [m] + atm2lnd_inst%forc_hgt_q_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of humidity [m] + + 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_pco2_grc(g) = co2_ppmv * 1.e-6_r8 * 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) + + water_inst%wateratm2lndbulk_inst%forc_rain_not_downscaled_grc(g) = forc_rainc(g) + forc_rainl(g) + water_inst%wateratm2lndbulk_inst%forc_snow_not_downscaled_grc(g) = forc_snowc(g) + forc_snowl(g) + + + if (forc_t > SHR_CONST_TKFRZ) then + e = esatw(tdc(forc_t)) + else + e = esati(tdc(forc_t)) + end if + qsat = 0.622_r8*e / (forc_pbot - 0.378_r8*e) + + ! modify specific humidity if precip occurs + if (1==2) then + if ((forc_rainc(g)+forc_rainl(g)) > 0._r8) then + forc_q = 0.95_r8*qsat + !forc_q = qsat + water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q + endif + endif + + water_inst%wateratm2lndbulk_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat) + water_inst%wateratm2lndbulk_inst%volr_grc(g) = 0._r8 + water_inst%wateratm2lndbulk_inst%volrmch_grc(g) = 0._r8 + end do + + !-------------------------- + ! Error checks + !-------------------------- + + ! Check that solar, specific-humidity and LW downward aren't negative + do g = begg,endg + if ( atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) <= 0.0_r8 ) then + call shr_sys_abort( subname//& + ' ERROR: Longwave down sent from the atmosphere model is negative or zero' ) + end if + if ( (atm2lnd_inst%forc_solad_grc(g,1) < 0.0_r8) .or. & + (atm2lnd_inst%forc_solad_grc(g,2) < 0.0_r8) .or. & + (atm2lnd_inst%forc_solai_grc(g,1) < 0.0_r8) .or. & + (atm2lnd_inst%forc_solai_grc(g,2) < 0.0_r8) ) then + call shr_sys_abort( subname//& + ' ERROR: One of the solar fields (indirect/diffuse, vis or near-IR)'// & + ' from the atmosphere model is negative or zero' ) + end if + if ( water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) < 0.0_r8 )then + call shr_sys_abort( subname//& + ' ERROR: Bottom layer specific humidty sent from the atmosphere model is less than zero' ) + end if + end do + + ! 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) ) + + end subroutine import_fields + + !=============================================================================== + + subroutine check_atm_landfrac(importState, bounds, rc) + + ! ------------------------------------------------------------------------ + ! Import Sa_landfrac and check it against CTSM's internal land mask. + ! + ! We require that CTSM's internal land mask contains all of the atmosphere's land + ! points (defined as points with landfrac > 0). It is okay for CTSM to include some + ! points that the atmosphere considers to be ocean, but not the reverse. + ! ------------------------------------------------------------------------ + + ! input/output variables + type(ESMF_State) :: importState + type(bounds_type) , intent(in) :: bounds + integer , intent(out) :: rc + + ! local variables + real(r8), pointer :: atm_landfrac(:) + integer :: last_land_index + integer :: n + + character(len=*), parameter :: subname='(check_atm_landfrac)' + !--------------------------------------------------------------------------- + + ! Implementation notes: The CTSM decomposition is set up so that ocean points appear + ! at the end of the vectors received from the coupler. Thus, in order to check if + ! there are any points that the atmosphere considers land but CTSM considers ocean, + ! it is sufficient to check the points following the typical ending bounds in the + ! vectors received from the coupler. + ! + ! Note that we can't use state_getimport here, because that only gets points from + ! bounds%begg:bounds%endg, whereas we want the points following bounds%endg. + + call state_getfldptr(importState, 'c2l_fb_atm', 'Sa_landfrac', fldptr1d=atm_landfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + last_land_index = bounds%endg - bounds%begg + 1 + do n = last_land_index + 1, ubound(atm_landfrac, 1) + if (atm_landfrac(n) > 0._r8) then + write(iulog,*) 'At point ', n, ' atm landfrac = ', atm_landfrac(n) + write(iulog,*) 'but CTSM thinks this is ocean.' + write(iulog,*) "Make sure the mask on CTSM's fatmlndfrc file agrees with the atmosphere's land mask" + call shr_sys_abort( subname//& + ' ERROR: atm landfrac > 0 for a point that CTSM thinks is ocean') + end if + end do + + end subroutine check_atm_landfrac + + !============================================================================== + + subroutine export_fields(exportState, bounds, rc) + + !------------------------------- + ! Pack the export state + !------------------------------- + + ! input/output variables + type(ESMF_State) :: exportState + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(out) :: rc + + ! local variables + integer :: i, g, num + real(r8) :: array(bounds%begg:bounds%endg) + character(len=*), parameter :: subname='(lnd_import_export:export_fields)' + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! ----------------------- + ! output to atm + ! ----------------------- + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_t', bounds, & + input=lnd2atm_inst%t_rad_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_snowh', bounds, & + input=water_inst%waterlnd2atmbulk_inst%h2osno_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_avsdr', bounds, & + input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_anidr', bounds, & + input=lnd2atm_inst%albd_grc(bounds%begg:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_avsdf', bounds, & + input=lnd2atm_inst%albi_grc(bounds%begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_anidf', bounds, & + input=lnd2atm_inst%albi_grc(bounds%begg:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_tref', bounds, & + input=lnd2atm_inst%t_ref2m_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_qref', bounds, & + input=water_inst%waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_u10', bounds, & + input=lnd2atm_inst%u_ref10m_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_taux', bounds, & + input=lnd2atm_inst%taux_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_tauy', bounds, & + input=lnd2atm_inst%tauy_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_lat', bounds, & + input=lnd2atm_inst%eflx_lh_tot_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_sen', bounds, & + input=lnd2atm_inst%eflx_sh_tot_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_lwup', bounds, & + input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_evap', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_swnet', bounds, & + input=lnd2atm_inst%fsa_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst1', bounds, & + input=lnd2atm_inst%flxdst_grc(:,1), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst2', bounds, & + input=lnd2atm_inst%flxdst_grc(:,2), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst3', bounds, & + input=lnd2atm_inst%flxdst_grc(:,3), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst4', bounds, & + input=lnd2atm_inst%flxdst_grc(:,4), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_ram1', bounds, & + input=lnd2atm_inst%ram1_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_fv', bounds, & + input=lnd2atm_inst%fv_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_z0m', bounds, & + input=lnd2atm_inst%z0m_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! methanem + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_methane', bounds, & + ! input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! soil water + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_soilw', bounds, & + ! input=water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! dry dep velocities + ! do num = 1, drydep_nflds + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_ddvel', bounds, & + ! input=lnd2atm_inst%ddvel_grc(:,num), ungridded_index=num, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end do + + ! MEGAN VOC emis fluxes + ! do num = 1, shr_megan_mechcomps_n + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_voc', bounds, & + ! input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., ungridded_index=num, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end do + + ! fire emis fluxes + ! do num = 1, emis_nflds + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_fire', bounds, & + ! input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., ungridded_index=num, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end do + ! if (emis_nflds > 0) then + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_fztopo', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! 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 + + ! ----------------------- + ! output to river + ! ----------------------- + + ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf + ! do g = bounds%begg,bounds%endg + ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & + ! water_inst%waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) + ! end do + + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofsur', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain + do g = bounds%begg,bounds%endg + array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) + end do + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofsub', bounds, & + input=array, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! qgwl sent individually to coupler + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofgwl', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ice sent individually to coupler + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofi', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! irrigation flux to be removed from main channel storage (negative) + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_irrig', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine export_fields + + !=============================================================================== + + subroutine state_getimport(state, fb, fldname, bounds, output, ungridded_index, rc) + + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fb + character(len=*) , intent(in) :: fldname + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(out) :: output(bounds%begg:bounds%endg) + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: g, i,n + real(R8), pointer :: fldptr1d(:) + real(R8), pointer :: fldptr2d(:,:) + character(len=cs) :: cvalue + character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + if (masterproc .and. debug > 0) then + write(iulog,F01)' Show me what is in the state? for '//trim(fldname) + call ESMF_StatePrint(state, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Get the pointer to data in the field + if (present(ungridded_index)) then + write(cvalue,*) ungridded_index + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Fill in output array + if (present(ungridded_index)) then + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr2d(ungridded_index,n) + end do + else + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr1d(n) + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + write(iulog,F02)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) + end if + end do + end if + + ! Write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = bounds%begg,bounds%endg + i = 1 + g - bounds%begg + write(iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) + end do + end if + + ! Check for nans + call check_for_nans(output, trim(fldname), bounds%begg) + + end subroutine state_getimport + + !=============================================================================== + + subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_index, rc) + + ! ---------------------------------------------- + ! Map input array to export state field + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fb + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: input(bounds%begg:bounds%endg) + logical, optional , intent(in) :: minus + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + logical :: l_minus ! local version of minus + integer :: g, i, n + real(R8), pointer :: fldptr1d(:) + real(R8), pointer :: fldptr2d(:,:) + character(len=cs) :: cvalue + character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + l_minus = .false. + if (present(minus)) then + l_minus = minus + end if + + ! get field pointer + if (present(ungridded_index)) then + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! determine output array + if (present(ungridded_index)) then + fldptr2d(ungridded_index,:) = fillvalue + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + if (l_minus) then + fldptr2d(ungridded_index,n) = -input(g) + else + fldptr2d(ungridded_index,n) = input(g) + end if + end do + else + fldptr1d(:) = fillvalue + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + if (l_minus) then + fldptr1d(n) = -input(g) + else + fldptr1d(n) = input(g) + end if + end do + end if + + ! write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = bounds%begg,bounds%endg + i = 1 + g - bounds%begg + write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) + end do + end if + + ! check for nans + call check_for_nans(input, trim(fldname), bounds%begg) + + end subroutine state_setexport + + !=============================================================================== + + subroutine state_getfldptr(State, fb, fldname, fldptr1d, fldptr2d, rc) + + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fb + character(len=*), intent(in) :: fldname + real(R8), pointer, optional , intent(out) :: fldptr1d(:) + real(R8), pointer, optional , intent(out) :: fldptr2d(:,:) + integer, intent(out) :: rc + + ! local variables + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + integer :: nnodes, nelements + type(ESMF_FieldBundle) :: fieldBundle + character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the fieldbundle from the state... + call ESMF_StateGet(state, trim(fb), fieldBundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("ERROR: fb "//trim(fb)//" not found in state") + + ! Get the field from the field bundle + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get the status of the field + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (nnodes == 0 .and. nelements == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + ! Get the data from the field + if (present(fldptr1d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc .and. debug > 0) then + write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' + end if + else if (present(fldptr2d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") + end if + endif ! status + + end subroutine state_getfldptr + + !=============================================================================== + + subroutine check_for_nans(array, fname, begg) + + ! input/output variables + real(r8) , intent(in) :: array(:) + character(len=*) , intent(in) :: fname + integer , intent(in) :: begg + ! + ! local variables + integer :: i + !------------------------------------------------------------------------------- + + ! Check if any input from lilac or output to lilac is NaN + + if (any(isnan(array))) then + write(iulog,*) '# of NaNs = ', count(isnan(array)) + write(iulog,*) 'Which are NaNs = ', isnan(array) + do i = 1, size(array) + if (isnan(array(i))) then + write(iulog,*) "NaN found in field ", trim(fname), ' at gridcell index ',begg+i-1 + end if + end do + call shr_sys_abort(' ERROR: One or more of the output from CLM to the coupler are NaN ' ) + end if + end subroutine check_for_nans + +end module lnd_import_export diff --git a/src/cpl/lilac/lnd_shr_methods.F90 b/src/cpl/lilac/lnd_shr_methods.F90 new file mode 100644 index 0000000000..078aef08d9 --- /dev/null +++ b/src/cpl/lilac/lnd_shr_methods.F90 @@ -0,0 +1,210 @@ +module lnd_shr_methods + + use ESMF + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + + implicit none + private + + public :: state_diagnose + public :: chkerr + + private :: field_getfldptr + + ! Module data + character(len=1024) :: msgString + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine state_diagnose(State, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + type(ESMf_Field) :: lfield + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(r8), pointer :: dataPtr1d(:) + real(r8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(state_diagnose)' + ! ---------------------------------------------- + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call field_getfldptr(lfield, rc=rc, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + enddo + + deallocate(lfieldnamelist) + + end subroutine state_diagnose + +!=============================================================================== + + subroutine field_getfldptr(field, rc, fldptr1, fldptr2, rank, abort) + + ! ---------------------------------------------- + ! for a field, determine rank and return fldptr1 or fldptr2 + ! abort is true by default and will abort if fldptr is not yet allocated in field + ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + integer , intent(out) :: rc + real(r8), pointer , intent(inout), optional :: fldptr1(:) + real(r8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + + ! local variables + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(field_getfldptr)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + ESMF_LOGMSG_INFO) + elseif (lrank == 1) then + if (.not.present(fldptr1)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 2) then + if (.not.present(fldptr2)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + end subroutine field_getfldptr + +!=============================================================================== + + logical function chkerr(rc, line, file) + + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + + integer :: lrc + + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + +end module lnd_shr_methods diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 index 8a8f86342b..b5b46ca97e 100644 --- a/src/cpl/mct/lnd_comp_mct.F90 +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -42,7 +42,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! !USES: 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_time_manager , only : get_nstep, set_timemgr_init, set_nextsw_cday use clm_initializeMod, only : initialize1, initialize2 use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland @@ -82,7 +82,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) integer :: lsize ! size of attribute vector integer :: g,i,j ! indices integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: dtime_clm ! clm time-step logical :: exists ! true if file exists logical :: atm_aero ! Flag if aerosol data sent from atm model real(r8) :: scmlat ! single-column latitude @@ -100,8 +99,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) integer :: ref_tod ! reference time of day (sec) integer :: start_ymd ! start date (YYYYMMDD) integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type integer :: lbnum ! input to memory diagnostic integer :: shrlogunit,shrloglev ! old values for log unit and log level @@ -167,18 +164,25 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call seq_timemgr_EClockGetData(EClock, & start_ymd=start_ymd, & start_tod=start_tod, ref_ymd=ref_ymd, & - ref_tod=ref_tod, stop_ymd=stop_ymd, & - stop_tod=stop_tod, & - calendar=calendar ) + ref_tod=ref_tod, & + calendar=calendar, & + dtime=dtime_sync) + if (masterproc) then + write(iulog,*)'dtime = ',dtime_sync + end if + call seq_infodata_GetData(infodata, case_name=caseid, & case_desc=ctitle, single_column=single_column, & scmlat=scmlat, scmlon=scmlon, & brnch_retain_casename=brnch_retain_casename, & start_type=starttype, model_version=version, & hostname=hostname, username=username ) + + ! Note that we assume that CTSM's internal dtime matches the coupling time step. + ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & - ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, & - stop_tod_in=stop_tod) + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, dtime_in=dtime_sync) + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then nsrest = nsrStartup else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then @@ -197,7 +201,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! Read namelist, grid and surface data - call initialize1( ) + call initialize1(dtime=dtime_sync) ! If no land then exit out of initialization @@ -233,20 +237,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call initialize2() - ! Check that clm internal dtime aligns with clm coupling interval - - call seq_timemgr_EClockGetData(EClock, dtime=dtime_sync ) - dtime_clm = get_step_size() - if (masterproc) then - write(iulog,*)'dtime_sync= ',dtime_sync,& - ' dtime_clm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) - end if - if (mod(dtime_sync,dtime_clm) /= 0) then - write(iulog,*)'clm dtime ',dtime_clm,' and Eclock dtime ',& - dtime_sync,' never align' - call endrun( sub//' ERROR: time out of sync' ) - end if - ! Create land export state call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) @@ -420,6 +410,15 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) ! Determine if dosend ! When time is not updated at the beginning of the loop - then return only if ! are in sync with clock before time is updated + ! + ! NOTE(wjs, 2020-03-09) I think the do while (.not. dosend) loop only is important + ! for the first time step (when we run 2 steps). After that, we now assume that we + ! run one time step per coupling interval (based on setting the model's dtime from + ! the driver). (According to Mariana Vertenstein, sub-cycling (running multiple + ! land model time steps per coupling interval) used to be supported, but hasn't + ! been fully supported for a long time.) We may want to rework this logic to make + ! this more explicit, or - ideally - get rid of this extra time step at the start + ! of the run, at which point I think we could do away with this looping entirely. call get_curr_date( yr, mon, day, tod ) ymd = yr*10000 + mon*100 + day @@ -439,7 +438,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) end if call update_rad_dtime(doalb) - ! Determine if time to write cam restart and stop + ! Determine if time to write restart and stop rstwr = .false. if (rstwr_sync .and. dosend) rstwr = .true. diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 075c93c8ed..172030f777 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -342,7 +342,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_DistGrid) :: DistGrid ! esmf global index space descriptor type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep ! Model timestep type(ESMF_Calendar) :: esmf_calendar ! esmf calendar @@ -352,12 +351,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: yy,mm,dd ! Temporaries for time query integer :: start_ymd ! start date (YYYYMMDD) integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) integer :: curr_ymd ! Start date (YYYYMMDD) integer :: curr_tod ! Start time of day (sec) integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: dtime_clm ! ctsm time-step integer, pointer :: gindex(:) ! global index space for land and ocean points integer, pointer :: gindex_lnd(:) ! global index space for just land points integer, pointer :: gindex_ocn(:) ! global index space for just ocean points @@ -479,7 +475,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------- call ESMF_ClockGet( clock, & - currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & + currTime=currTime, startTime=startTime, refTime=RefTime, & timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -491,10 +487,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,start_ymd) - call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,stop_ymd) - call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,ref_ymd) @@ -510,6 +502,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) end if + call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (masterproc) then + write(iulog,*)'dtime = ', dtime_sync + end if + !---------------------- ! Initialize module orbital values and update orbital !---------------------- @@ -524,14 +523,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize CTSM time manager !---------------------- + ! Note that we assume that CTSM's internal dtime matches the coupling time step. + ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( & calendar_in=calendar, & start_ymd_in=start_ymd, & start_tod_in=start_tod, & ref_ymd_in=ref_ymd, & ref_tod_in=ref_tod, & - stop_ymd_in=stop_ymd, & - stop_tod_in=stop_tod) + dtime_in=dtime_sync) !---------------------- ! Read namelist, grid and surface data @@ -548,7 +548,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) username_in=username) ! note that the memory for gindex_ocn will be allocated in the following call - call initialize1(gindex_ocn) + call initialize1(dtime=dtime_sync, gindex_ocn=gindex_ocn) ! If no land then abort for now ! TODO: need to handle the case of noland with CMEPS @@ -706,26 +706,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end do 100 format(a,3(d13.5,2x)) - !-------------------------------- - ! Check that ctsm internal dtime aligns with ctsm coupling interval - !-------------------------------- - - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - dtime_clm = get_step_size() - - if (masterproc) then - write(iulog,*)'dtime_sync= ',dtime_sync,' dtime_ctsm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) - end if - if (mod(dtime_sync,dtime_clm) /= 0) then - write(iulog,*)'ctsm dtime ',dtime_clm,' and clock dtime ',dtime_sync,' never align' - rc = ESMF_FAILURE - return - end if - !-------------------------------- ! Create land export state !-------------------------------- @@ -1008,11 +988,12 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) - if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) ) then + if ( (ymd /= ymd_sync) .or. (tod /= tod_sync) ) then write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync - rc = ESMF_FAILURE call ESMF_LogWrite(subname//" CTSM clock not in sync with Master Sync clock",ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return end if !-------------------------------- diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 396ecaf344..c55f1e16b4 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -979,7 +979,7 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound if (num > fldsMax) then call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return + call shr_sys_abort(trim(subname)//": ERROR: num > fldsMax") endif fldlist(num)%stdname = trim(stdname) @@ -1196,6 +1196,7 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index integer , intent(out) :: rc ! local variables + logical :: l_minus ! local version of minus integer :: g, i, n real(R8), pointer :: fldptr1d(:) real(R8), pointer :: fldptr2d(:,:) @@ -1206,6 +1207,11 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index rc = ESMF_SUCCESS + l_minus = .false. + if (present(minus)) then + l_minus = minus + end if + ! Determine if field with name fldname exists in state call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1238,7 +1244,7 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index n = g - bounds%begg + 1 fldptr2d(ungridded_index,n) = input(g) end do - if (present(minus)) then + if (l_minus) then fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) end if else @@ -1248,7 +1254,7 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index n = g - bounds%begg + 1 fldptr1d(n) = input(g) end do - if (present(minus)) then + if (l_minus) then fldptr1d(:) = -fldptr1d(:) end if end if diff --git a/src/cpl/nuopc/lnd_shr_methods.F90 b/src/cpl/nuopc/lnd_shr_methods.F90 index 344eda650e..13438e855f 100644 --- a/src/cpl/nuopc/lnd_shr_methods.F90 +++ b/src/cpl/nuopc/lnd_shr_methods.F90 @@ -321,7 +321,7 @@ subroutine state_diagnose(State, string, rc) call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + call field_getfldptr(lfield, rc=rc, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank) if (chkerr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then @@ -354,7 +354,7 @@ end subroutine state_diagnose !=============================================================================== - subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) + subroutine field_getfldptr(field, rc, fldptr1, fldptr2, rank, abort) ! ---------------------------------------------- ! for a field, determine rank and return fldptr1 or fldptr2 @@ -364,11 +364,11 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) ! input/output variables type(ESMF_Field) , intent(in) :: field + integer , intent(out) :: rc real(r8), pointer , intent(inout), optional :: fldptr1(:) real(r8), pointer , intent(inout), optional :: fldptr2(:,:) integer , intent(out) , optional :: rank logical , intent(in) , optional :: abort - integer , intent(out) , optional :: rc ! local variables type(ESMF_GeomType_Flag) :: geomtype @@ -379,13 +379,6 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) character(len=*), parameter :: subname='(field_getfldptr)' ! ---------------------------------------------- - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - rc = ESMF_SUCCESS labort = .true. diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 4c117abc35..f06c49bc12 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -628,6 +628,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Determine fluxes ! ============================================================================ + call t_startf('bgp_fluxes') call t_startf('bgflux') ! Bareground fluxes for all patches except lakes and urban landunits @@ -710,6 +711,19 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro humanindex_inst) call t_stopf('bgplake') + call frictionvel_inst%SetActualRoughnessLengths( & + bounds = bounds_clump, & + num_exposedvegp = filter(nc)%num_exposedvegp, & + filter_exposedvegp = filter(nc)%exposedvegp, & + num_noexposedvegp = filter(nc)%num_noexposedvegp, & + filter_noexposedvegp = filter(nc)%noexposedvegp, & + num_urbanp = filter(nc)%num_urbanp, & + filter_urbanp = filter(nc)%urbanp, & + num_lakep = filter(nc)%num_lakep, & + filter_lakep = filter(nc)%lakep) + + call t_stopf('bgp_fluxes') + if (irrigate) then ! ============================================================================ diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 442a77c36b..4616aecc09 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -41,7 +41,7 @@ module clm_initializeMod contains !----------------------------------------------------------------------- - subroutine initialize1(gindex_ocn) + subroutine initialize1(dtime, gindex_ocn) ! ! !DESCRIPTION: ! CLM initialization first phase @@ -63,6 +63,8 @@ subroutine initialize1(gindex_ocn) use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp ! ! !ARGUMENTS + integer, intent(in) :: dtime ! model time step (seconds) + ! COMPILER_BUG(wjs, 2020-02-20, intel18.0.3) Although gindex_ocn could be ! intent(out), intel18.0.3 generates a runtime segmentation fault in runs that don't ! have this argument present when this is declared intent(out). (It works fine on @@ -100,7 +102,7 @@ subroutine initialize1(gindex_ocn) call shr_sys_flush(iulog) endif - call control_init() + call control_init(dtime) call ncd_pio_init() call surfrd_get_num_patches(fsurdat, actual_maxsoil_patches, actual_numcft) call clm_varpar_init(actual_maxsoil_patches, actual_numcft) @@ -287,7 +289,7 @@ subroutine initialize2( ) use clm_varctl , only : use_crop, ndep_from_cpl use clm_varorb , only : eccen, mvelpp, lambm0, obliqr use clm_time_manager , only : get_step_size_real, get_curr_calday - use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep + use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep use clm_time_manager , only : timemgr_init, timemgr_restart_io, timemgr_restart, is_restart use CIsoAtmTimeseriesMod , only : C14_init_BombSpike, use_c14_bombspike, C13_init_TimeSeries, use_c13_timeseries use DaylengthMod , only : InitDaylength diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 18818591db..9896277faa 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -109,13 +109,13 @@ subroutine control_setNL( NLfile ) end subroutine control_setNL !------------------------------------------------------------------------ - subroutine control_init( ) + + subroutine control_init(dtime) ! ! !DESCRIPTION: ! Initialize CLM run control information ! ! !USES: - use clm_time_manager , only : set_timemgr_init use CNMRespMod , only : CNMRespReadNML use LunaMod , only : LunaReadNML use CNNDynamicsMod , only : CNNDynamicsReadNML @@ -123,11 +123,13 @@ subroutine control_init( ) use CNPhenologyMod , only : CNPhenologyReadNML use landunit_varcon , only : max_lunit ! + ! ARGUMENTS + integer, intent(in) :: dtime ! model time step (seconds) + ! !LOCAL VARIABLES: integer :: i ! loop indices integer :: ierr ! error code integer :: unitn ! unit for namelist file - integer :: dtime ! Integer time-step logical :: use_init_interp ! Apply initInterp to the file given by finidat !------------------------------------------------------------------------ @@ -135,10 +137,6 @@ subroutine control_init( ) ! Namelist Variables ! ---------------------------------------------------------------------- - ! Time step - namelist / clm_inparm/ & - dtime - ! CLM namelist settings namelist /clm_inparm / & @@ -341,20 +339,17 @@ subroutine control_init( ) ! Process some namelist variables, and perform consistency checks ! ---------------------------------------------------------------------- - call set_timemgr_init( dtime_in=dtime ) - - if (use_init_interp) then - call apply_use_init_interp(finidat_interp_dest, finidat, finidat_interp_source) - end if - - ! History and restart files - + ! History and restart files (dependent on settings of dtime) do i = 1, max_tapes if (hist_nhtfrq(i) < 0) then hist_nhtfrq(i) = nint(-hist_nhtfrq(i)*SHR_CONST_CDAY/(24._r8*dtime)) endif end do + if (use_init_interp) then + call apply_use_init_interp(finidat_interp_dest, finidat, finidat_interp_source) + end if + if (maxpatch_glcmec <= 0) then call endrun(msg=' ERROR: maxpatch_glcmec must be at least 1 ' // & errMsg(sourcefile, __LINE__)) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 5737ebfc3a..7405e6166b 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -5256,9 +5256,6 @@ subroutine hist_do_disp (ntapes, hist_ntimes, hist_mfilt, if_stop, if_disphist, ! Remove history files unless this is end of run or ! history file is not full. ! - ! !USES: - use clm_time_manager, only : is_last_step - ! ! !ARGUMENTS: integer, intent(in) :: ntapes !actual number of history tapes integer, intent(in) :: hist_ntimes(ntapes) !current numbers of time samples on history tape diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index 2fbea9433a..9a18428264 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -240,6 +240,11 @@ subroutine lnd2atm(bounds, & 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%z0m_actual_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%z0m_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'urbans', l2g_scale_type='unity') + call p2g(bounds, & frictionvel_inst%fv_patch (bounds%begp:bounds%endp), & lnd2atm_inst%fv_grc (bounds%begg:bounds%endg), & diff --git a/src/main/lnd2atmType.F90 b/src/main/lnd2atmType.F90 index a0e8623018..d3dcd9a202 100644 --- a/src/main/lnd2atmType.F90 +++ b/src/main/lnd2atmType.F90 @@ -47,6 +47,7 @@ module lnd2atmType 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 :: fsa_grc (:) => null() ! solar rad absorbed (total) (W/m**2) + real(r8), pointer :: z0m_grc (:) => null() ! roughness length, momentum (m) real(r8), pointer :: net_carbon_exchange_grc(:) => null() ! net CO2 flux (kg CO2/m**2/s) [+ to atm] real(r8), pointer :: nem_grc (:) => null() ! gridcell average net methane correction to CO2 flux (g C/m^2/s) real(r8), pointer :: ram1_grc (:) => null() ! aerodynamical resistance (s/m) @@ -145,6 +146,7 @@ subroutine InitAllocate(this, bounds) 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%fsa_grc (begg:endg)) ; this%fsa_grc (:) =ival + allocate(this%z0m_grc (begg:endg)) ; this%z0m_grc (:) =ival allocate(this%net_carbon_exchange_grc(begg:endg)) ; this%net_carbon_exchange_grc(:) =ival allocate(this%nem_grc (begg:endg)) ; this%nem_grc (:) =ival allocate(this%ram1_grc (begg:endg)) ; this%ram1_grc (:) =ival @@ -268,6 +270,14 @@ subroutine InitHistory(this, bounds) ptr_lnd=this%net_carbon_exchange_grc, & default='inactive') + ! No need to set this to spval (or 0) because it is a gridcell-level field, so should + ! have valid values everywhere + call hist_addfld1d(fname='Z0M_TO_COUPLER', units='m', & + avgflag='A', & + long_name='roughness length, momentum: gridcell average sent to coupler', & + ptr_lnd=this%z0m_grc, & + default='inactive') + if (use_lch4) then this%ch4_surf_flux_tot_grc(begg:endg) = 0._r8 call hist_addfld1d (fname='FCH4', units='kgC/m2/s', & diff --git a/src/main/restFileMod.F90 b/src/main/restFileMod.F90 index 4f718b9228..91967c5ed3 100644 --- a/src/main/restFileMod.F90 +++ b/src/main/restFileMod.F90 @@ -361,9 +361,6 @@ subroutine restFile_closeRestart( file ) ! Close restart file and write restart pointer file if ! in write mode, otherwise just close restart file if in read mode ! - ! !USES: - use clm_time_manager, only : is_last_step - ! ! !ARGUMENTS: character(len=*) , intent(in) :: file ! local output filename ! diff --git a/src/unit_test_shr/unittestTimeManagerMod.F90 b/src/unit_test_shr/unittestTimeManagerMod.F90 index 72ff57b9b9..b22cea2e65 100644 --- a/src/unit_test_shr/unittestTimeManagerMod.F90 +++ b/src/unit_test_shr/unittestTimeManagerMod.F90 @@ -63,7 +63,6 @@ subroutine unittest_timemgr_setup(dtime) ! Set ymd values to be year N, month 1, day 1 integer, parameter :: start_ymd = 10101 integer, parameter :: ref_ymd = start_ymd - integer, parameter :: stop_ymd = 20101 integer, parameter :: perpetual_ymd = start_ymd ! Set current time to be at the start of year 1 @@ -92,11 +91,8 @@ subroutine unittest_timemgr_setup(dtime) start_tod_in = 0, & ref_ymd_in = ref_ymd, & ref_tod_in = 0, & - stop_ymd_in = stop_ymd, & - stop_tod_in = 0, & perpetual_run_in = .false., & perpetual_ymd_in = perpetual_ymd, & - nelapse_in = 1, & dtime_in = l_dtime) call timemgr_init() diff --git a/src/utils/clm_time_manager.F90 b/src/utils/clm_time_manager.F90 index 889258fd06..9ad956ebc8 100644 --- a/src/utils/clm_time_manager.F90 +++ b/src/utils/clm_time_manager.F90 @@ -14,14 +14,12 @@ module clm_time_manager ! Public methods public ::& - get_timemgr_defaults, &! get startup default values set_timemgr_init, &! setup startup values timemgr_init, &! time manager initialization timemgr_restart_io, &! read/write time manager restart info and restart time manager timemgr_restart, &! restart the time manager using info from timemgr_restart timemgr_datediff, &! calculate difference between two time instants advance_timestep, &! increment timestep number - get_clock, &! get the clock from the time-manager get_curr_ESMF_Time, &! get current time in terms of the ESMF_Time get_step_size, &! return step size in seconds get_step_size_real, &! return step size in seconds, real-valued @@ -54,7 +52,6 @@ module clm_time_manager is_end_curr_month, &! return true on last timestep in current month is_beg_curr_year, &! return true on first timestep in current year is_end_curr_year, &! return true on last timestep in current year - is_last_step, &! return true on last timestep is_perpetual, &! return true if perpetual calendar is in use is_near_local_noon, &! return true if near local noon is_restart, &! return true if this is a restart run @@ -78,6 +75,9 @@ module clm_time_manager integer, parameter :: uninit_int = -999999999 real(r8), parameter :: uninit_r8 = -999999999.0 + ! We'll use this really big year to effectively mean infinitely into the future. + integer, parameter :: really_big_year = 999999999 + ! Input integer, save ::& dtime = uninit_int, &! timestep in seconds @@ -86,11 +86,8 @@ module clm_time_manager ! Input from CESM driver integer, save ::& - nelapse = uninit_int, &! number of timesteps (or days if negative) to extend a run start_ymd = uninit_int, &! starting date for run in yearmmdd format start_tod = 0, &! starting time of day for run in seconds - stop_ymd = uninit_int, &! stopping date for run in yearmmdd format - stop_tod = 0, &! stopping time of day for run in seconds ref_ymd = uninit_int, &! reference date for time coordinate in yearmmdd format ref_tod = 0 ! reference time of day for time coordinate in seconds type(ESMF_Calendar), target, save :: tm_cal ! calendar @@ -111,7 +108,6 @@ module clm_time_manager logical, save :: tm_first_restart_step = .false. ! true for first step of a restart or branch run logical, save :: tm_perp_calendar = .false. ! true when using perpetual calendar logical, save :: timemgr_set = .false. ! true when timemgr initialized - integer, save :: nestep = uninit_int ! ending time-step ! ! Next short-wave radiation calendar day ! @@ -126,7 +122,6 @@ module clm_time_manager private :: timemgr_spmdbcast private :: init_calendar private :: init_clock - private :: calc_nestep private :: timemgr_print private :: TimeGetymd private :: check_timemgr_initialized @@ -135,57 +130,18 @@ module clm_time_manager contains !========================================================================================= - subroutine get_timemgr_defaults( calendar_out, start_ymd_out, start_tod_out, ref_ymd_out, & - ref_tod_out, stop_ymd_out, stop_tod_out, nelapse_out, & - dtime_out ) - - !--------------------------------------------------------------------------------- - ! get time manager startup default values - ! - ! Arguments - character(len=*), optional, intent(OUT) :: calendar_out ! Calendar type - integer , optional, intent(OUT) :: nelapse_out ! Number of step (or days) to advance - integer , optional, intent(OUT) :: start_ymd_out ! Start date (YYYYMMDD) - integer , optional, intent(OUT) :: start_tod_out ! Start time of day (sec) - integer , optional, intent(OUT) :: ref_ymd_out ! Reference date (YYYYMMDD) - integer , optional, intent(OUT) :: ref_tod_out ! Reference time of day (sec) - integer , optional, intent(OUT) :: stop_ymd_out ! Stop date (YYYYMMDD) - integer , optional, intent(OUT) :: stop_tod_out ! Stop time of day (sec) - integer , optional, intent(OUT) :: dtime_out ! Time-step (sec) - ! - character(len=*), parameter :: sub = 'clm::get_timemgr_defaults' - - if ( timemgr_set ) call shr_sys_abort( sub//":: timemgr_init or timemgr_restart already called" ) - if (present(calendar_out) ) calendar_out = trim(calendar) - if (present(start_ymd_out) ) start_ymd_out = start_ymd - if (present(start_tod_out) ) start_tod_out = start_tod - if (present(ref_ymd_out) ) ref_ymd_out = ref_ymd - if (present(ref_tod_out) ) ref_tod_out = ref_tod - if (present(stop_ymd_out) ) stop_ymd_out = stop_ymd - if (present(stop_tod_out) ) stop_tod_out = stop_tod - if (present(nelapse_out) ) nelapse_out = nelapse - if (present(dtime_out) ) dtime_out = dtime - - end subroutine get_timemgr_defaults - - !========================================================================================= - subroutine set_timemgr_init( calendar_in, start_ymd_in, start_tod_in, ref_ymd_in, & - ref_tod_in, stop_ymd_in, stop_tod_in, perpetual_run_in, & - perpetual_ymd_in, nelapse_in, dtime_in ) + ref_tod_in, perpetual_run_in, perpetual_ymd_in, dtime_in ) !--------------------------------------------------------------------------------- ! set time manager startup values ! ! Arguments character(len=*), optional, intent(IN) :: calendar_in ! Calendar type - integer , optional, intent(IN) :: nelapse_in ! Number of step (or days) to advance integer , optional, intent(IN) :: start_ymd_in ! Start date (YYYYMMDD) integer , optional, intent(IN) :: start_tod_in ! Start time of day (sec) integer , optional, intent(IN) :: ref_ymd_in ! Reference date (YYYYMMDD) integer , optional, intent(IN) :: ref_tod_in ! Reference time of day (sec) - integer , optional, intent(IN) :: stop_ymd_in ! Stop date (YYYYMMDD) - integer , optional, intent(IN) :: stop_tod_in ! Stop time of day (sec) logical , optional, intent(IN) :: perpetual_run_in ! If in perpetual mode or not integer , optional, intent(IN) :: perpetual_ymd_in ! Perpetual date (YYYYMMDD) integer , optional, intent(IN) :: dtime_in ! Time-step (sec) @@ -198,8 +154,6 @@ subroutine set_timemgr_init( calendar_in, start_ymd_in, start_tod_in, r if (present(start_tod_in) ) start_tod = start_tod_in if (present(ref_ymd_in) ) ref_ymd = ref_ymd_in if (present(ref_tod_in) ) ref_tod = ref_tod_in - if (present(stop_ymd_in) ) stop_ymd = stop_ymd_in - if (present(stop_tod_in) ) stop_tod = stop_tod_in if (present(perpetual_run_in) )then tm_perp_calendar = perpetual_run_in if ( tm_perp_calendar ) then @@ -208,7 +162,6 @@ subroutine set_timemgr_init( calendar_in, start_ymd_in, start_tod_in, r perpetual_ymd = perpetual_ymd_in end if end if - if (present(nelapse_in) ) nelapse = nelapse_in if (present(dtime_in) ) dtime = dtime_in end subroutine set_timemgr_init @@ -224,13 +177,9 @@ subroutine timemgr_init( ) ! character(len=*), parameter :: sub = 'clm::timemgr_init' integer :: rc ! return code - integer :: yr, mon, day, tod ! Year, month, day, and second as integers type(ESMF_Time) :: start_date ! start date for run - type(ESMF_Time) :: stop_date ! stop date for run type(ESMF_Time) :: curr_date ! temporary date used in logic type(ESMF_Time) :: ref_date ! reference date for time coordinate - logical :: run_length_specified = .false. - type(ESMF_Time) :: current ! current date (from clock) type(ESMF_TimeInterval) :: day_step_size ! day step size type(ESMF_TimeInterval) :: step_size ! timestep size !--------------------------------------------------------------------------------- @@ -256,53 +205,12 @@ subroutine timemgr_init( ) curr_date = start_date - ! Initalize stop date. - - stop_date = TimeSetymd( 99991231, stop_tod, "stop_date" ) - call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') call ESMF_TimeIntervalSet( day_step_size, d=1, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting day_step_size') - if ( stop_ymd /= uninit_int ) then - current = TimeSetymd( stop_ymd, stop_tod, "stop_date" ) - if ( current < stop_date ) stop_date = current - run_length_specified = .true. - end if - if ( nelapse /= uninit_int ) then - if ( nelapse >= 0 ) then - current = curr_date + step_size*nelapse - else - current = curr_date - day_step_size*nelapse - end if - if ( current < stop_date ) stop_date = current - run_length_specified = .true. - end if - if ( .not. run_length_specified ) then - call shr_sys_abort (sub//': Must specify stop_ymd or nelapse') - end if - - ! Error check - - if ( stop_date <= start_date ) then - write(iulog,*)sub, ': stop date must be specified later than start date: ' - call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod - call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod - call shr_sys_abort - end if - if ( curr_date >= stop_date ) then - write(iulog,*)sub, ': stop date must be specified later than current date: ' - call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod - call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod - call shr_sys_abort - end if - ! Initalize reference date for time coordinate. if ( ref_ymd /= uninit_int ) then @@ -313,7 +221,7 @@ subroutine timemgr_init( ) ! Initialize clock - call init_clock( start_date, ref_date, curr_date, stop_date ) + call init_clock( start_date, ref_date, curr_date) ! Initialize date used for perpetual calendar day calculation. @@ -331,26 +239,53 @@ end subroutine timemgr_init !========================================================================================= - subroutine init_clock( start_date, ref_date, curr_date, stop_date ) + subroutine init_clock( start_date, ref_date, curr_date ) !--------------------------------------------------------------------------------- - ! Purpose: Initialize the clock based on the start_date, ref_date, and curr_date - ! as well as the settings from the namelist specifying the time to stop + ! Purpose: Initialize the clock based on the start_date, ref_date and curr_date ! type(ESMF_Time), intent(in) :: start_date ! start date for run type(ESMF_Time), intent(in) :: ref_date ! reference date for time coordinate type(ESMF_Time), intent(in) :: curr_date ! current date (equal to start_date) - type(ESMF_Time), intent(in) :: stop_date ! stop date for run ! character(len=*), parameter :: sub = 'clm::init_clock' + type(ESMF_Time) :: stop_date ! stop date for run type(ESMF_TimeInterval) :: step_size ! timestep size type(ESMF_Time) :: current ! current date (from clock) + integer :: yr, mon, day, tod ! Year, month, day, and second as integers integer :: rc ! return code !--------------------------------------------------------------------------------- call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') + ! We don't use a stop time in the CTSM clock. Instead, we set the clock to + ! effectively have a stop time infinitely far into the future, and rely on other + ! mechanisms to tell CTSM when to stop. If we were always using the real ESMF + ! library, we could avoid setting the stopTime on the clock. But the ESMF time + ! manager included in cime appears to require stopTime. + call ESMF_TimeSet(stop_date, yy=really_big_year, mm=12, dd=31, s=0, & + calendar=tm_cal, rc=rc) + + ! Error check + + if ( stop_date <= start_date ) then + write(iulog,*)sub, ': Assumed stop date is earlier than start date: ' + call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod + call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod + call shr_sys_abort + end if + if ( stop_date <= curr_date ) then + write(iulog,*)sub, ': Assumed stop date is earlier than current date: ' + call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod + call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod + call shr_sys_abort + end if + ! Initialize the clock tm_clock = ESMF_ClockCreate(name="CLM Time-manager clock", timeStep=step_size, startTime=start_date, & @@ -555,11 +490,8 @@ subroutine timemgr_restart( ) type(ESMF_Time) :: start_date ! start date for run type(ESMF_Time) :: ref_date ! reference date for run type(ESMF_Time) :: curr_date ! date of data in restart file - type(ESMF_Time) :: stop_date ! stop date for run - type(ESMF_Time) :: current ! current date (from clock) type(ESMF_TimeInterval) :: day_step_size ! day step size type(ESMF_TimeInterval) :: step_size ! timestep size - logical :: run_length_specified = .false. !--------------------------------------------------------------------------------- call timemgr_spmdbcast( ) @@ -579,52 +511,12 @@ subroutine timemgr_restart( ) curr_date = TimeSetymd( rst_curr_ymd, rst_curr_tod, "curr_date" ) - ! Initialize stop date from sync clock or namelist input - - stop_date = TimeSetymd( 99991231, stop_tod, "stop_date" ) - call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') call ESMF_TimeIntervalSet( day_step_size, d=1, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting day_step_size') - if ( stop_ymd /= uninit_int ) then - current = TimeSetymd( stop_ymd, stop_tod, "stop_date" ) - if ( current < stop_date ) stop_date = current - run_length_specified = .true. - else if ( nelapse /= uninit_int ) then - if ( nelapse >= 0 ) then - current = curr_date + step_size*nelapse - else - current = curr_date - day_step_size*nelapse - end if - if ( current < stop_date ) stop_date = current - run_length_specified = .true. - end if - if ( .not. run_length_specified ) then - call shr_sys_abort (sub//': Must specify stop_ymd or nelapse') - end if - - ! Error check - - if ( stop_date <= start_date ) then - write(iulog,*)sub, ': stop date must be specified later than start date: ' - call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod - call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod - call shr_sys_abort - end if - if ( curr_date >= stop_date ) then - write(iulog,*)sub, ': stop date must be specified later than current date: ' - call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod - call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod - call shr_sys_abort - end if - ! Initialize nstep_rad_prev from restart info nstep_rad_prev = rst_nstep_rad_prev @@ -635,7 +527,7 @@ subroutine timemgr_restart( ) ! Initialize clock - call init_clock( start_date, ref_date, curr_date, stop_date ) + call init_clock( start_date, ref_date, curr_date) ! Advance the timestep. ! Data from the restart file corresponds to the last timestep of the previous run. @@ -646,10 +538,6 @@ subroutine timemgr_restart( ) tm_first_restart_step = .true. - ! Calculate ending time step - - call calc_nestep( ) - ! Print configuration summary to log file (stdout). if (masterproc) call timemgr_print() @@ -660,33 +548,6 @@ end subroutine timemgr_restart !========================================================================================= - subroutine calc_nestep() - !--------------------------------------------------------------------------------- - ! - ! Calculate ending timestep number - ! Calculation of ending timestep number (nestep) assumes a constant stepsize. - ! - character(len=*), parameter :: sub = 'clm::calc_nestep' - integer :: ntspday ! Number of time-steps per day - type(ESMF_TimeInterval) :: diff ! - type(ESMF_Time) :: start_date ! start date for run - type(ESMF_Time) :: stop_date ! stop date for run - integer :: ndays, nsecs ! Number of days, seconds to ending time - integer :: rc ! return code - !--------------------------------------------------------------------------------- - - call ESMF_ClockGet( tm_clock, stopTime=stop_date, startTime=start_date, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_ClockGet') - ntspday = isecspday/dtime - diff = stop_date - start_date - call ESMF_TimeIntervalGet( diff, d=ndays, s=nsecs, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet calculating nestep') - nestep = ntspday*ndays + nsecs/dtime - if ( mod(nsecs,dtime) /= 0 ) nestep = nestep + 1 - end subroutine calc_nestep - - !========================================================================================= - subroutine init_calendar( ) !--------------------------------------------------------------------------------- @@ -728,10 +589,6 @@ subroutine timemgr_print() start_mon = uninit_int, &! start month start_day = uninit_int, &! start day of month start_tod = uninit_int, &! start time of day - stop_yr = uninit_int, &! stop year - stop_mon = uninit_int, &! stop month - stop_day = uninit_int, &! stop day of month - stop_tod = uninit_int, &! stop time of day ref_yr = uninit_int, &! reference year ref_mon = uninit_int, &! reference month ref_day = uninit_int, &! reference day of month @@ -742,14 +599,13 @@ subroutine timemgr_print() curr_tod = uninit_int ! current time of day integer(ESMF_KIND_I8) :: step_no type(ESMF_Time) :: start_date! start date for run - type(ESMF_Time) :: stop_date ! stop date for run type(ESMF_Time) :: curr_date ! date of data in restart file type(ESMF_Time) :: ref_date ! reference date type(ESMF_TimeInterval) :: step ! Time-step !--------------------------------------------------------------------------------- call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, & - refTime=ref_date, stopTime=stop_date, timeStep=step, & + refTime=ref_date, timeStep=step, & advanceCount=step_no, rc=rc ) call chkrc(rc, sub//': error return from ESMF_ClockGet') nstep = step_no @@ -762,9 +618,6 @@ subroutine timemgr_print() call ESMF_TimeGet( start_date, yy=start_yr, mm=start_mon, dd=start_day, & s=start_tod, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeGet') - call ESMF_TimeGet( stop_date, yy=stop_yr, mm=stop_mon, dd=stop_day, & - s=stop_tod, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_TimeGet') call ESMF_TimeGet( ref_date, yy=ref_yr, mm=ref_mon, dd=ref_day, s=ref_tod, & rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeGet') @@ -776,12 +629,9 @@ subroutine timemgr_print() write(iulog,*)' Timestep size (seconds): ', step_sec write(iulog,*)' Start date (yr mon day tod): ', start_yr, start_mon, & start_day, start_tod - write(iulog,*)' Stop date (yr mon day tod): ', stop_yr, stop_mon, & - stop_day, stop_tod write(iulog,*)' Reference date (yr mon day tod): ', ref_yr, ref_mon, & ref_day, ref_tod write(iulog,*)' Current step number: ', nstep - write(iulog,*)' Ending step number: ', nestep write(iulog,*)' Current date (yr mon day tod): ', curr_yr, curr_mon, & curr_day, curr_tod @@ -814,30 +664,6 @@ end subroutine advance_timestep !========================================================================================= - subroutine get_clock( clock ) - - ! Return the ESMF clock - - type(ESMF_Clock), intent(inout) :: clock - - character(len=*), parameter :: sub = 'clm::get_clock' - type(ESMF_TimeInterval) :: step_size - type(ESMF_Time) :: start_date, stop_date, ref_date - integer :: rc - - if ( .not. check_timemgr_initialized(sub) ) return - - call ESMF_ClockGet( tm_clock, timeStep=step_size, startTime=start_date, & - stoptime=stop_date, reftime=ref_date, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_ClockGet') - call ESMF_ClockSet(clock, timeStep=step_size, startTime=start_date, & - stoptime=stop_date, reftime=ref_date, rc=rc) - call chkrc(rc, sub//': error return from ESMF_ClockSet') - - end subroutine get_clock - - !========================================================================================= - function get_curr_ESMF_Time( ) ! Return the current time as ESMF_Time @@ -1780,34 +1606,6 @@ end function is_first_step_of_this_run_segment !========================================================================================= - logical function is_last_step() - - !--------------------------------------------------------------------------------- - ! Return true on last timestep. - - ! Local variables - character(len=*), parameter :: sub = 'clm::is_last_step' - type(ESMF_Time) :: stop_date - type(ESMF_Time) :: curr_date - type(ESMF_TimeInterval) :: time_step - integer :: rc - !--------------------------------------------------------------------------------- - - if ( .not. check_timemgr_initialized(sub) ) return - - call ESMF_ClockGet( tm_clock, stopTime=stop_date, & - currTime=curr_date, TimeStep=time_step, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_ClockGet') - if ( curr_date+time_step > stop_date ) then - is_last_step = .true. - else - is_last_step = .false. - end if - - end function is_last_step - - !========================================================================================= - logical function is_perpetual() ! Return true on last timestep. @@ -1982,11 +1780,8 @@ subroutine timemgr_reset() dtime_rad = uninit_int nstep_rad_prev = uninit_int - nelapse = uninit_int start_ymd = uninit_int start_tod = 0 - stop_ymd = uninit_int - stop_tod = 0 ref_ymd = uninit_int ref_tod = 0 @@ -2004,7 +1799,6 @@ subroutine timemgr_reset() tm_first_restart_step = .false. tm_perp_calendar = .false. timemgr_set = .false. - nestep = uninit_int nextsw_cday = uninit_r8